excel - 循环遍历 workbook.close 上的文件时代码停止

Question

我试图遍历 Excel 文件，打开它们，运行一些破解密码的代码，然后关闭工作簿并移至下一个。

我的代码适用于我的大部分文件。我在处理包含宏的文件时遇到问题。 (这是我能看到的唯一将这些文件与其他文件区分开来的东西。)

我注意到当我打开有问题的文件时，我的 wb 变量设置为空。它仍然打开文件并且我的代码继续运行但是当我执行 wb.close 行时我的代码只是停止。没有错误消息，但它没有完成它所在的循环。

不确定是否有一种方法可以附加一个有效的文件和一个无效的文件，但如果有人可以解释如何执行此操作，我可以。

当我打开一个不会导致这个问题的文件时，在locals窗口中当我展开变量wb时，它有其他属性。在问题文件上，当我展开 wb 变量时，它只是说:没有变量

当我在不使用 VBA 的情况下打开其中一个文件时，我收到一条警告，指出它可能包含安全问题并且宏已被禁用。我认为这就是我的问题所在，但我认为我是用 Application.AutomationSecurity = msoAutomationSecurityForceDisable 来处理这个问题的。

我已将我的代码更新为以下内容，但它并没有解决在 wb.close 上停止代码的问题

Do While fileName <> vbNullString

    Set wb = Workbooks.Open(fileName:=directory & fileName, _
                            UpdateLinks:=0, _
                            IgnoreReadOnlyRecommended:=True, _
                            Notify:=False, _
                            CorruptLoad:=xlNormalLoad)
    If Err.Number = 0 And Not wb Is Nothing Then
        On Error GoTo 0
        Call AllInternalPasswords
        wb.Close True
        fileName = Dir()
    Else
        Err.Clear
        On Error GoTo 0
    End If
Loop

---

Sub TestPasswordLoop()

Dim directory As String, fileName As String, i As Variant, wb As Workbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim security As MsoAutomationSecurity
security = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityForceDisable

directory = "C:\Users\seth\Desktop\Files for Testing\"
fileName = Dir(directory & "*.xl??")

i = 0
Do While fileName <> vbNullString
    On Error Resume Next
    'Set wb = Workbooks.Open(fileName:=directory & fileName)
    Set wb = Workbooks.Open(fileName:=directory & fileName, _
                            UpdateLinks:=0, _
                            IgnoreReadOnlyRecommended:=True, _
                            Notify:=False, _
                            CorruptLoad:=xlNormalLoad)

    Call AllInternalPasswords 'this code is below
    wb.Close True
    i = i + 1
    Application.StatusBar = "Files Completed:  " & i
    fileName = Dir()
Loop

Application.AutomationSecurity = security
Application.StatusBar = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Complete"

End Sub

Public Sub AllInternalPasswords()
    ' Breaks worksheet and workbook structure passwords. Bob McCormick
    '  probably originator of base code algorithm modified for coverage
    '  of workbook structure / windows passwords and for multiple passwords
    '
    ' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1)
    ' Modified 2003-Apr-04 by JEM: All msgs to constants, and
    '   eliminate one Exit Sub (Version 1.1.1)
    ' Reveals hashed passwords NOT original passwords

    Application.DisplayAlerts = False
    'Application.ScreenUpdating = False

    Const DBLSPACE As String = vbNewLine & vbNewLine
    Const AUTHORS As String = DBLSPACE & vbNewLine & _
            "Adapted from Bob McCormick base code by" & _
            "Norman Harker and JE McGimpsey"
    Const HEADER As String = "AllInternalPasswords User Message"
    Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04"
    Const REPBACK As String = DBLSPACE & "Please report failure " & _
            "to the microsoft.public.excel.programming newsgroup."
    Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _
            "now be free of all password protection, so make sure you:" & _
            DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _
            DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _
            DBLSPACE & "Also, remember that the password was " & _
            "put there for a reason. Don't stuff up crucial formulas " & _
            "or data." & DBLSPACE & "Access and use of some data " & _
            "may be an offense. If in doubt, don't."
    Const MSGNOPWORDS1 As String = "There were no passwords on " & _
            "sheets, or workbook structure or windows." & AUTHORS & VERSION
    Const MSGNOPWORDS2 As String = "There was no protection to " & _
            "workbook structure or windows." & DBLSPACE & _
            "Proceeding to unprotect sheets." & AUTHORS & VERSION
    Const MSGTAKETIME As String = "After pressing OK button this " & _
            "will take some time." & DBLSPACE & "Amount of time " & _
            "depends on how many different passwords, the " & _
            "passwords, and your computer's specification." & DBLSPACE & _
            "Just be patient! Make me a coffee!" & AUTHORS & VERSION
    Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _
            "Structure or Windows Password set." & DBLSPACE & _
            "The password found was: " & DBLSPACE & "$$" & DBLSPACE & _
            "Note it down for potential future use in other workbooks by " & _
            "the same person who set this password." & DBLSPACE & _
            "Now to check and clear other passwords." & AUTHORS & VERSION
    Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _
            "password set." & DBLSPACE & "The password found was: " & _
            DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _
            "future use in other workbooks by same person who " & _
            "set this password." & DBLSPACE & "Now to check and clear " & _
            "other passwords." & AUTHORS & VERSION
    Const MSGONLYONE As String = "Only structure / windows " & _
             "protected with the password that was just found." & _
             ALLCLEAR & AUTHORS & VERSION & REPBACK
    Dim w1 As Worksheet, w2 As Worksheet
    Dim i As Integer, j As Integer, k As Integer, l As Integer
    Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer
    Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer
    Dim PWord1 As String
    Dim ShTag As Boolean, WinTag As Boolean

    Application.ScreenUpdating = False
    With ActiveWorkbook
        WinTag = .ProtectStructure Or .ProtectWindows
    End With
    ShTag = False
    For Each w1 In Worksheets
            ShTag = ShTag Or w1.ProtectContents
    Next w1
    If Not ShTag And Not WinTag Then
        'MsgBox MSGNOPWORDS1, vbInformation, HEADER
        Exit Sub
    End If
    'MsgBox MSGTAKETIME, vbInformation, HEADER
    If Not WinTag Then
        'MsgBox MSGNOPWORDS2, vbInformation, HEADER
    Else
      On Error Resume Next
      Do      'dummy do loop
        For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
        For l = 65 To 66: For m = 65 To 66: 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 n = 32 To 126
        With ActiveWorkbook
          .Unprotect Chr(i) & Chr(j) & Chr(k) & _
             Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
             Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
          If .ProtectStructure = False And _
          .ProtectWindows = False Then
              PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
                Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
                Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
              'MsgBox Application.Substitute(MSGPWORDFOUND1, _
                    "$$", PWord1), vbInformation, HEADER
              Exit Do  'Bypass all for...nexts
          End If
        End With
        Next: Next: Next: Next: Next: Next
        Next: Next: Next: Next: Next: Next
      Loop Until True
      On Error GoTo 0
    End If
    If WinTag And Not ShTag Then
      'MsgBox MSGONLYONE, vbInformation, HEADER
      Exit Sub
    End If
    On Error Resume Next
    For Each w1 In Worksheets
      'Attempt clearance with PWord1
      w1.Unprotect PWord1
    Next w1
    On Error GoTo 0
    ShTag = False
    For Each w1 In Worksheets
      'Checks for all clear ShTag triggered to 1 if not.
      ShTag = ShTag Or w1.ProtectContents
    Next w1
    If ShTag Then
        For Each w1 In Worksheets
          With w1
            If .ProtectContents Then
              On Error Resume Next
              Do      'Dummy do loop
                For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
                For l = 65 To 66: For m = 65 To 66: 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 n = 32 To 126
                .Unprotect Chr(i) & Chr(j) & Chr(k) & _
                  Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
                  Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
                If Not .ProtectContents Then
                  PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
                    Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
                    Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
                  'MsgBox Application.Substitute(MSGPWORDFOUND2, _
                        "$$", PWord1), vbInformation, HEADER
                  'leverage finding Pword by trying on other sheets
                  For Each w2 In Worksheets
                    w2.Unprotect PWord1
                  Next w2
                  Exit Do  'Bypass all for...nexts
                End If
                Next: Next: Next: Next: Next: Next
                Next: Next: Next: Next: Next: Next
              Loop Until True
              On Error GoTo 0
            End If
          End With
        Next w1
    End If
    'MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER

    'Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Answer 1

用于错误检查:

保存前尝试保存工作簿

Application.DisplayAlerts  = False
     wb.Save
     wb.Close True
Application.DisplayAlerts  = True

---

用于错误检查:

尝试将 Error Trapping 设置为“Break on All Errors”。 (在 VBA 编辑器中:工具 > 选项 > 常规 > 出现所有错误时中断)

您的“On Error Resume Next”隐藏了错误