Question

我正在尝试使用VBA打开可能具有密码保护宏的文件。下面的代码可以成功检测具有无密码的宏的文件，但无法获取具有密码保护宏的文件。有关如何修复它的任何建议？

Dim wb As Workbook
Set wb = Application.Workbooks.Open(EUC_Path, UpdateLinks:=False)
If wb.VBProject.VBComponents.Count > 0 Then
    ThisWorkbook.Worksheets(1).Range("F" & i).Value = "Yes"
Else
    ThisWorkbook.Worksheets(1).Range("F" & i).Value = "No"
End If

提前致谢。

更新：我意识到我上面的描述不是很清楚，但我的最终目标是在确定工作表是否有宏开始后，实际读取每个宏中的行数。我检查行数的代码是：

With wb.VBProject
    Number_Macro = 0
    For k = 1 To .VBComponents.Count
        Line_Count = .VBComponents.Item(k).CodeModule.CountOfLines
    next k
End with

因此，我不必通过错误消息检测宏保护，而是必须能够真正访问受密码保护的宏。有人可以告诉我吗？

由于

Answer 1

您根本无法迭代受保护的VB项目的VBComponents集合。

所以你需要第三个状态：

受保护的

您可以通过VBProject属性验证Protection是否受到保护。

If wb.VBProject.Protection = vbext_ProjectProtection.vbext_pp_none Then
    ' good to go
Else
    ' can't access components
End If

实际上，如果一个VBA项目受到保护，假设它有VBA代码可能是安全的，所以“是”似乎是合理的。

此外，您的逻辑存在缺陷：任何 Excel VBA项目将至少 2个组件：

Sheet1（总共至少有一个Worksheet个对象）
ThisWorkbook（总共至少有一个Workbook个对象）

默认情况下，实际上会有4：Sheet1，Sheet2，Sheet3，然后是ThisWorkbook。但这取决于用户配置/ Excel设置，因此模块的数量并不意味着什么 - 无论项目是否有宏。

我刚刚打开了一个.xlsx（没有宏！）工作簿，.VBProject.VBComponents.Count返回了137。

要知道如果工作簿中包含宏，则需要找到具有公共成员的标准模块。

...但是，文档模块（例如Sheet2或ThisWorkbook）本身可能无法公开任何宏，但仍然具有处理的VBA代码工作簿或工作表事件 - 因此您需要先确定是否至少有一个文档模块至少包含一个过程，然后才能自信地说“此文件包含宏”。

Answer 2

您最好的选择是记录受保护的文件，返回并手动解锁，保存副本，然后重新运行这些特定文件。

Private Sub LogVBA_tst()
    Dim wb As Excel.Workbook
    Set wb = LogVBA(Environ("USERPROFILE") & "\Documents\Code\MSO\Excel\VBA Examples")
    wb.Activate
End Sub
Private Function LogVBA(EUC_Path As String) As Excel.Workbook
    'Required references
    '   VBIDE: Microsoft Visual Basic for Applications Extensibility 5.3
    '   VBScript_RegExp_55: Microsoft VBScript Regular Expressions 5.5
    Dim fso As Object, fldr As Object, fle As Object
    Set fso = CreateObject("Scripting.FilesystemObject")
    If Not fso.FolderExists(EUC_Path) Then Exit Function
    Set fldr = fso.GetFolder(EUC_Path)

    Dim logWB As Excel.Workbook: Set logWB = Application.Workbooks.Add
    Dim logWS As Excel.Worksheet: Set logWS = logWB.Worksheets.Add
    Const BlockPattern As String = "^( |\t)*(Private\s|Public\s|Friend\s)?(Static\s)?<Block>\s(.|\n)*?\n\s*End <Block>.*?$"
    Dim BlockRE As New VBScript_RegExp_55.RegExp: BlockRE.Global = True: BlockRE.IgnoreCase = True: BlockRE.MultiLine = True
    Const NameCOL As Long = 1
    Const HasVBACOL As Long = NameCOL + 1
    Const TotalLinesCOL As Long = HasVBACOL + 1
    Dim ComRE As New VBScript_RegExp_55.RegExp: ComRE.Pattern = "^( |\t)*'.*$": ComRE.Global = True: ComRE.IgnoreCase = True: ComRE.MultiLine = True
    Const ComLinesCOL As Long = TotalLinesCOL + 1
    Const CompsCtCOL As Long = ComLinesCOL + 1
    Const FunCtCOL As Long = CompsCtCOL + 1
    Const FunLinesCOL As Long = FunCtCOL + 1
    Const SubCtCOL As Long = FunLinesCOL + 1
    Const SubLinesCOL As Long = SubCtCOL + 1
    Const PropCtCOL As Long = SubLinesCOL + 1
    Const PropLinesCOL As Long = PropCtCOL + 1
    Const EnumCtCOL As Long = PropLinesCOL + 1
    Const EnumLinesCOL As Long = EnumCtCOL + 1
    Const TypeCtCOL As Long = EnumLinesCOL + 1
    Const TypeLinesCOL As Long = TypeCtCOL + 1
    Dim WBcompFlag As Boolean
    Const WBcodeCOL As Long = TypeLinesCOL + 1
    Const WBcodeLinesCOL As Long = WBcodeCOL + 1
    Const SheetCtCOL As Long = WBcodeLinesCOL + 1
    Const SheetLinesCOL As Long = SheetCtCOL + 1
    Const ModuleCtCOL As Long = SheetLinesCOL + 1
    Const ModuleLinesCOL As Long = ModuleCtCOL + 1
    Const ClassCtCOL As Long = ModuleLinesCOL + 1
    Const ClassLinesCOL As Long = ClassCtCOL + 1
    Const FormCtCOL As Long = ClassLinesCOL + 1
    Const FormLinesCOL As Long = FormCtCOL + 1
    Dim mtch As VBScript_RegExp_55.Match

    Dim LogNdx As Long: LogNdx = 1 'Log Header Row
    logWS.Cells(LogNdx, NameCOL).Value = "File Name"
    logWS.Cells(LogNdx, HasVBACOL).Value = "VBA Present"
    logWS.Cells(LogNdx, TotalLinesCOL).Value = "Total Line Count"
    logWS.Cells(LogNdx, ComLinesCOL).Value = "Comment Lines count"
    logWS.Cells(LogNdx, CompsCtCOL).Value = "Components with VBA"
    logWS.Cells(LogNdx, FunCtCOL).Value = "Functions"
    logWS.Cells(LogNdx, FunLinesCOL).Value = "Function Lines"
    logWS.Cells(LogNdx, SubCtCOL).Value = "Subs"
    logWS.Cells(LogNdx, SubLinesCOL).Value = "Sub Lines"
    logWS.Cells(LogNdx, PropCtCOL).Value = "Properties"
    logWS.Cells(LogNdx, PropLinesCOL).Value = "Property Lines"
    logWS.Cells(LogNdx, EnumCtCOL).Value = "Enumerations"
    logWS.Cells(LogNdx, EnumLinesCOL).Value = "Enum Lines"
    logWS.Cells(LogNdx, TypeCtCOL).Value = "User-Defined Data Types(UDT)"
    logWS.Cells(LogNdx, TypeLinesCOL).Value = "UDT Lines"
    logWS.Cells(LogNdx, WBcodeCOL).Value = "Workbook VBA"
    logWS.Cells(LogNdx, WBcodeLinesCOL).Value = "Workbook Lines"
    logWS.Cells(LogNdx, SheetCtCOL).Value = "Worksheets with VBA"
    logWS.Cells(LogNdx, SheetLinesCOL).Value = "Worksheet Lines"
    logWS.Cells(LogNdx, ModuleCtCOL).Value = "Modules"
    logWS.Cells(LogNdx, ModuleLinesCOL).Value = "Module Lines"
    logWS.Cells(LogNdx, ClassCtCOL).Value = "Class Modules"
    logWS.Cells(LogNdx, ClassLinesCOL).Value = "Class Lines"
    logWS.Cells(LogNdx, FormCtCOL).Value = "Forms"
    logWS.Cells(LogNdx, FormLinesCOL).Value = "Form Lines"
    LogNdx = LogNdx + 1 'Start Log Data

    Dim wb As Excel.Workbook, comp As VBIDE.VBComponent, CompCode As String, CodeLines As Variant, lc As Long, ProcessWB As Boolean
    For Each fle In fldr.Files
    Select Case LCase(Right(fle.Name, 4))
      Case ".xls", "xlsm", "xlsb" 'Filter files for excle VBA files
        logWS.Cells(LogNdx, NameCOL).Value = fle.Path
        Set wb = Application.Workbooks.Open(FileName:=fle.Path, UpdateLinks:=0, ReadOnly:=True, AddToMru:=False)

        If wb.HasVBProject Then 'Filter workbooks for ones with VBA
            ProcessWB = False
            If wb.VBProject.Protection = VBIDE.vbext_pp_locked Then
                logWS.Cells(LogNdx, HasVBACOL).Value = "Locked"
'                ToDo - Write: Private Function UnlockWBVBA(wb as Excel.Workbook) as Excel.Workbook
'                       Perform this step manually until implemented.
'                Set wb=UnlockWBVBA(wb)
'                ProcessWB = Not (wb Is Nothing)
            Else
                logWS.Cells(LogNdx, HasVBACOL).Value = "Yes"
                ProcessWB = True
            End If
        If ProcessWB Then
            For Each comp In wb.VBProject.VBComponents
                lc = comp.CodeModule.CountOfLines
            If lc > 0 Then 'Filter components for ones with lines
                logWS.Cells(LogNdx, TotalLinesCOL).Value = logWS.Cells(LogNdx, TotalLinesCOL).Value + lc
                logWS.Cells(LogNdx, CompsCtCOL).Value = logWS.Cells(LogNdx, CompsCtCOL).Value + 1
                Select Case comp.Type
                  Case VBIDE.vbext_ct_Document
                    On Error Resume Next
                    WBcompFlag = True: WBcompFlag = Not (comp.Properties("Columns").Name = "Columns")
                    On Error GoTo 0
                  If WBcompFlag Then 'Case Workbook
                    logWS.Cells(LogNdx, WBcodeCOL).Value = "Yes"
                    logWS.Cells(LogNdx, WBcodeLinesCOL).Value = lc
                  Else 'Case Worksheet
                    logWS.Cells(LogNdx, SheetCtCOL).Value = logWS.Cells(LogNdx, SheetCtCOL).Value + 1
                    logWS.Cells(LogNdx, SheetLinesCOL).Value = logWS.Cells(LogNdx, SheetLinesCOL).Value + lc
                  End If
                  Case VBIDE.vbext_ct_StdModule
                    logWS.Cells(LogNdx, ModuleCtCOL).Value = logWS.Cells(LogNdx, ModuleCtCOL).Value + 1
                    logWS.Cells(LogNdx, ModuleLinesCOL).Value = logWS.Cells(LogNdx, ModuleLinesCOL).Value + lc
                  Case VBIDE.vbext_ct_ClassModule
                    logWS.Cells(LogNdx, ClassCtCOL).Value = logWS.Cells(LogNdx, ClassCtCOL).Value + 1
                    logWS.Cells(LogNdx, ClassLinesCOL).Value = logWS.Cells(LogNdx, ClassLinesCOL).Value + lc
                  Case VBIDE.vbext_ct_MSForm
                    logWS.Cells(LogNdx, FormCtCOL).Value = logWS.Cells(LogNdx, FormCtCOL).Value + 1
                    logWS.Cells(LogNdx, FormLinesCOL).Value = logWS.Cells(LogNdx, FormLinesCOL).Value + lc
                End Select
                CompCode = comp.CodeModule.Lines(1, lc)

                'Parse Comments
                For Each mtch In ComRE.Execute(CompCode)
                    logWS.Cells(LogNdx, ComLinesCOL).Value = logWS.Cells(LogNdx, ComLinesCOL).Value + 1
                Next mtch

                'Parse Functions
                BlockRE.Pattern = Replace(BlockPattern, "<Block>", "Function")
                For Each mtch In BlockRE.Execute(CompCode)
                    logWS.Cells(LogNdx, FunCtCOL).Value = logWS.Cells(LogNdx, FunCtCOL).Value + 1
                    CodeLines = Split(mtch.Value, vbNewLine)
                    logWS.Cells(LogNdx, FunLinesCOL).Value = logWS.Cells(LogNdx, FunLinesCOL).Value + 1 + UBound(CodeLines) - LBound(CodeLines)
                Next mtch

                'Parse Subs
                BlockRE.Pattern = Replace(BlockPattern, "<Block>", "Sub")
                For Each mtch In BlockRE.Execute(CompCode)
                    logWS.Cells(LogNdx, SubCtCOL).Value = logWS.Cells(LogNdx, SubCtCOL).Value + 1
                    CodeLines = Split(mtch.Value, vbNewLine)
                    logWS.Cells(LogNdx, SubLinesCOL).Value = logWS.Cells(LogNdx, SubLinesCOL).Value + 1 + UBound(CodeLines) - LBound(CodeLines)
                Next mtch

                'Parse Properties
                BlockRE.Pattern = Replace(BlockPattern, "<Block>", "Property")
                For Each mtch In BlockRE.Execute(CompCode)
                    logWS.Cells(LogNdx, PropCtCOL).Value = logWS.Cells(LogNdx, PropCtCOL).Value + 1
                    CodeLines = Split(mtch.Value, vbNewLine)
                    logWS.Cells(LogNdx, PropLinesCOL).Value = logWS.Cells(LogNdx, PropLinesCOL).Value + 1 + UBound(CodeLines) - LBound(CodeLines)
                Next mtch

                'Parse Enumerations
                BlockRE.Pattern = Replace(Replace(Replace(BlockPattern, "<Block>", "Enum"), "|Friend\s", ""), "(Static\s)?", "")
                For Each mtch In BlockRE.Execute(CompCode)
                    logWS.Cells(LogNdx, EnumCtCOL).Value = logWS.Cells(LogNdx, EnumCtCOL).Value + 1
                    CodeLines = Split(mtch.Value, vbNewLine)
                    logWS.Cells(LogNdx, EnumLinesCOL).Value = logWS.Cells(LogNdx, EnumLinesCOL).Value + 1 + UBound(CodeLines) - LBound(CodeLines)
                Next mtch

                'Parse User-Defined Types
                BlockRE.Pattern = Replace(Replace(Replace(BlockPattern, "<Block>", "Type"), "|Friend\s", ""), "(Static\s)?", "")
                For Each mtch In BlockRE.Execute(CompCode)
                    logWS.Cells(LogNdx, TypeCtCOL).Value = logWS.Cells(LogNdx, TypeCtCOL).Value + 1
                    CodeLines = Split(mtch.Value, vbNewLine)
                    logWS.Cells(LogNdx, TypeLinesCOL).Value = logWS.Cells(LogNdx, TypeLinesCOL).Value + 1 + UBound(CodeLines) - LBound(CodeLines)
                Next mtch
            End If: Next comp
        End If 'If ProcessWB
        Else: logWS.Cells(LogNdx, HasVBACOL).Value = "No"
        End If 'If wb.HasVBProject

        If Not (wb Is Nothing) Then wb.Close Savechanges:=False
        LogNdx = LogNdx + 1
      Case "xlsx"
        logWS.Cells(LogNdx, NameCOL).Value = fle.Path
        logWS.Cells(LogNdx, HasVBACOL).Value = "Skipped"
        LogNdx = LogNdx + 1
    End Select: Next fle
    logWS.UsedRange.AutoFilter
    logWS.UsedRange.EntireColumn.AutoFit
    Set LogVBA = logWB
End Function

VBA读取密码保护宏

2 个答案: