Excel 在工作簿上的文件中循环时停止代码。关闭

Excel 在工作簿上的文件中循环时停止代码。关闭,excel,vba,do-while,Excel,Vba,Do While,我正在尝试循环浏览Excel文件,打开它们,运行一些代码来破解密码,然后关闭工作簿并移动到下一个工作簿 我的代码适用于我的大多数文件。我对包含宏的文件有问题。(这是我能看到的唯一区别于其他文件的东西。) 我注意到,对于问题文件,当我打开它们时,我的wb变量设置为nothing。它仍然打开文件,我的代码继续运行,但当我执行wb.close行时,我的代码就停止了。没有错误消息,但它没有完成它所在的循环 不确定是否有一种方法可以附加一个有效的文件和一个无效的文件,但如果有人能解释如何做,我可以 当我打

我正在尝试循环浏览Excel文件,打开它们,运行一些代码来破解密码,然后关闭工作簿并移动到下一个工作簿

我的代码适用于我的大多数文件。我对包含宏的文件有问题。(这是我能看到的唯一区别于其他文件的东西。)

我注意到,对于问题文件,当我打开它们时,我的wb变量设置为nothing。它仍然打开文件,我的代码继续运行,但当我执行wb.close行时,我的代码就停止了。没有错误消息,但它没有完成它所在的循环

不确定是否有一种方法可以附加一个有效的文件和一个无效的文件,但如果有人能解释如何做,我可以

当我打开一个不会导致此问题的文件时,在我展开变量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
Do While fileName vbNullString
设置wb=Workbooks.Open(文件名:=目录和文件名_
UpdateLink:=0_
IgnoreReadOnlyRecommended:=真_
通知:=假_
损坏负载:=xlNormalLoad)
如果Err.Number=0且非wb为空,则
错误转到0
调用所有内部密码
wb.Close为真
fileName=Dir()
其他的
呃,明白了
错误转到0
如果结束
环

子测试密码循环()
Dim目录为字符串,文件名为字符串,i为变量,wb为工作簿
Application.DisplayAlerts=False
Application.ScreenUpdating=False
将安全性设置为MsoAutomationSecurity
安全性=应用程序。自动安全性
Application.AutomationSecurity=msoAutomationSecurityForceDisable
directory=“C:\Users\seth\Desktop\Files for Testing\”
fileName=Dir(目录&“*.xl??”)
i=0
当文件名为vbNullString时执行
出错时继续下一步
'Set wb=Workbooks.Open(文件名:=目录和文件名)
设置wb=Workbooks.Open(文件名:=目录和文件名_
UpdateLink:=0_
IgnoreReadOnlyRecommended:=真_
通知:=假_
损坏负载:=xlNormalLoad)
调用AllInternalPasswords'此代码如下
wb.Close为真
i=i+1
Application.StatusBar=“文件已完成:”&i
fileName=Dir()
环
Application.AutomationSecurity=安全性
Application.StatusBar=False
Application.ScreenUpdating=True
Application.DisplayAlerts=True
MsgBox“完成”
端接头
公用子系统AllInternalPasswords()
'断开工作表和工作簿结构密码。鲍勃·麦考密克
'可能是为覆盖范围而修改的基本代码算法的发起人
'的工作簿结构/windows密码和多个密码
'
'Norman Harker and JE McGimpsey 27-Dec-2002(版本1.1)
'由JEM于2003年4月4日修改:所有MSG均为常数,且
'消除一个出口接头(版本1.1.1)
'显示哈希密码而不是原始密码
Application.DisplayAlerts=False
'Application.ScreenUpdate=False
Const DBLSPACE As String=vbNewLine&vbNewLine
Const AUTHORS As String=DBLSPACE&vbNewLine&_
“改编自Bob McCormick的基本代码”_
“诺曼·哈克和杰·麦金普西”
Const HEADER As String=“AllInternalPasswords用户消息”
Const VERSION As String=DBLSPACE&“VERSION 1.1.1 2003-Apr-04”
Const REPBACK As String=DBLSPACE&“请报告失败”&_
“转到microsoft.public.excel.programming新闻组。”
Const ALLCLEAR As String=DBLSPACE&“工作簿应”&_
“现在不受所有密码保护,因此请确保:&”_
DBLSPACE&“立即保存!”&DBLSPACE&“以及”_
DBLSPACE&“备份!备份!!,备份!!!”&_
DBLSPACE&“另外,请记住密码是”&”_
“放在那里是有原因的。不要塞满关键的公式”&_
“或数据。”&DBLSPACE&“某些数据的访问和使用”&_
“可能是冒犯。如果有疑问,请不要。”
Const MSGNOPWORDS1 As String=“上没有密码”&_
“工作表或工作簿结构或窗口。”&作者和版本
Const MSGNOPWORDS2 As String=“对”&_
“工作簿结构或窗口。”&DBLSPACE&_
“继续取消对工作表的保护。”&作者和版本
Const MSGTAKETIME As String=“按下确定按钮后”和_
“需要一些时间。”&DBLSPACE&“时间量”&_
“取决于有多少不同的密码,”&_
“密码和您计算机的规格。”&DBLSPACE&_
“耐心点!给我煮杯咖啡!”&作者与版本
Const MSGPWORDFOUND1 As String=“您有一个工作表”&_
“结构或Windows密码集。”&DBLSPACE&_
“找到的密码是:”&DBLSPACE&“$$”&DBLSPACE&”_
“将其记录下来,以便将来在其他工作簿中使用”&_
“设置此密码的人。”&DBLSPACE&_
“现在检查并清除其他密码。”&作者和版本
Const MSGPWORDFOUND2 As String=“您有一个工作表”&_
“密码设置。”&DBLSPACE&“找到的密码为:&”_
DBLSPACE&“$$”&DBLSPACE&“记下它作为p
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
Application.DisplayAlerts  = False
     wb.Save
     wb.Close True
Application.DisplayAlerts  = True