[问题求助] VBS解开Excel工作表密码求助

闻启学

各位新年好  ，最近将VBA 解开工作表密码 修改为VBS  出现错误  VBS 我刚入门
目的 是将工作簿拖入VBS 就可以解开该工作簿 每一个工作表的 工作表密码
代码 在VBA 上通过的

求教大家

Set oExcel = CreateObject("Excel.Application")
Set oWorkBook = oExcel.Workbooks.Open(strPath)
For Each oSheet In oWorkBook .Sheets
    RemoveShProtect oSheet
Next
oWorkBook.Close False  ‘关闭文件
Set oWorkBook = Nothing
oExcel.Quit
Sub RemoveShProtect(mywst As Worksheet)
    Dim i1 As Integer, i2 As Integer, i3 As Integer
    Dim i4 As Integer, i5 As Integer, i6 As Integer
    Dim i7 As Integer, i8 As Integer, i9 As Integer
    Dim i10 As Integer, i11 As Integer, i12 As Integer
    Dim t As String
    On Error Resume Next
    If mywst.ProtectContents = False Then
        MsgBox mywst.Name & "该工作表没有保护密码!"
        Exit Sub
    End If
    t = Timer
    For i1 = 65 To 66: For i2 = 65 To 66: For i3 = 65 To 66
        For i4 = 65 To 66: For i5 = 65 To 66: For i6 = 65 To 66
            For i7 = 65 To 66: For i8 = 65 To 66: For i9 = 65 To 66
                For i10 = 65 To 66: For i11 = 65 To 66: For i12 = 32 To 126
                    mywst.Unprotect Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(i7) & Chr(i8) & Chr(i9) & Chr(i10) & Chr(i11) & Chr(i12)
                    If mywst.ProtectContents = False Then
                        MsgBox "解除工作表保护!用时" & Format(Timer - t, "0.00") & "秒"
                        Exit Sub
                    End If
                    Next: Next: Next: Next: Next: Next
                    Next: Next: Next: Next: Next: Next
                End Sub
复制代码

闻启学

回复 1# 闻启学


    多谢，代码运行时候 发生错误

闻启学

修改代码

但是最后保存文件发生异常

If WScript.Arguments.Count <> 1 Then
    MsgBox "参数异常"
    WScript.Quit()
End If
strPath = WScript.Arguments(0)
Set oExcel = CreateObject("Excel.Application")
Set oWorkBook = oExcel.Workbooks.Open(strPath)
For Each oSheet In oWorkBook.Sheets
 If oSheet.ProtectContents = False Then
        MsgBox oSheet.Name & "该工作表没有保护密码!"
        Exit for
  End If
    t = Timer
On Error Resume Next
    For i1 = 65 To 66: For i2 = 65 To 66: For i3 = 65 To 66
        For i4 = 65 To 66: For i5 = 65 To 66: For i6 = 65 To 66
            For i7 = 65 To 66: For i8 = 65 To 66: For i9 = 65 To 66
                For i10 = 65 To 66: For i11 = 65 To 66: For i12 = 32 To 126
                    oSheet.Unprotect Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(i7) & Chr(i8) & Chr(i9) & Chr(i10) & Chr(i11) & Chr(i12)
                    If oSheet.ProtectContents = False Then
                        MsgBox "解除工作表保护!用时" & Format(Timer - t, "0.00") & "秒"
                        Exit for
                    End If
                    Next: Next: Next: Next: Next: Next
                    Next: Next: Next: Next: Next: Next
Next
oWorkBook.Close true
Set oWorkBook = Nothing
oExcel.Quit
复制代码

czjt1234

If WScript.Arguments.Count <> 1 Then
    MsgBox "参数异常"
    WScript.Quit()
End If
strPath = WScript.Arguments(0)

Set oExcel = CreateObject("Excel.Application")
Set oWorkBook = oExcel.Workbooks.Open(strPath)
For Each oSheet In oWorkBook.Sheets
    RemoveShProtect oSheet
Next
oWorkBook.Close False    '关闭文件
Set oWorkBook = Nothing
oExcel.Quit()

Sub RemoveShProtect(mywst)
    Dim i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, t
    On Error Resume Next
    If mywst.ProtectContents = False Then
        MsgBox mywst.Name & "该工作表没有保护密码!"
        Exit Sub
    End If
    t = Timer()
    For i1 = 65 To 66 : For i2 = 65 To 66 : For i3 = 65 To 66
    For i4 = 65 To 66 : For i5 = 65 To 66 : For i6 = 65 To 66
    For i7 = 65 To 66 : For i8 = 65 To 66 : For i9 = 65 To 66
    For i10 = 65 To 66 : For i11 = 65 To 66 : For i12 = 32 To 126
        mywst.Unprotect Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(i7) & Chr(i8) & Chr(i9) & Chr(i10) & Chr(i11) & Chr(i12)
        If mywst.ProtectContents = False Then
            MsgBox "解除工作表保护!用时" & Format(Timer() - t, "0.00") & "秒"
            Exit Sub
        End If
    Next : Next : Next : Next : Next : Next : Next : Next : Next : Next : Next : Next
End Sub
复制代码