1

I'm trying to use VBA to open files that potentially have password protected macros. Below code can successfully detect the files with macros that have NO password, but fail to pick up the files with password protected macros. Any suggestions on how can I fix it? 

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

Thanks in advance.

Update: I realize that my above description wasn't very clear but my final goal is to actually read the number of lines in each macro, after determine whether the worksheet has macro to begin with. My code to check the number of lines is: 

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

Thus instead of detecting macro protection through error message, I have to be able to have a real access to the macro that is password protected. Can someone please advise me on that?

Thanks

Improve this question
2
  • Just to clarify: you're trying to determine if a workbook has macros, whether or not it's protected? If that's not your question, then your question is rather unclear. Mind an edit? Commented Dec 19, 2017 at 22:29
  • You can't access the code of a protected project, that's what project protection does. Either unprotect it by providing the correct password, or you hack into it, but without unprotecting the project you can't do what you want to do. You've already received answers showing you how to check for that and avoid dealing with an error. If your real question is "how to crack the password of a protected vba project" then you have quite a roundabout way to ask that question, and I'd suggest you ask exactly that to a google search; you'll find that question is already answered on this site. Commented Dec 23, 2017 at 4:24

2 Answers 2

Reset to default
3

You simply can't iterate the VBComponents collection of a protected VB project.

So you need a 3rd status:

Protected

You can verify whether a VBProject is protected through its Protection property.

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

Actually, if a VBA project is protected, it's probably safe to assume it has VBA code, so "YES" would seem reasonable.

Also your logic is flawed: any Excel VBA project is going to have at least 2 components:

  • Sheet1 (there's always at least 1 Worksheet object)
  • ThisWorkbook (there's always at least 1 Workbook object)

By default there would actually be 4: Sheet1, Sheet2, Sheet3, and then ThisWorkbook. But that's up to user configuration / Excel settings so the number of modules doesn't mean anything - whether or not a project has macros.

I've just opened a .xlsx (no macros!) workbook, and .VBProject.VBComponents.Count returned 137.

To know if a workbook has macros, you need to find a standard module that has public members.

...but then, a document module (e.g. Sheet2, or ThisWorkbook) could reasonably not expose any macros per se, but still have VBA code that handles workbook or worksheet events - so you need to figure out if there's at least one document module with at least one procedure before you can confidently say "this file contains macros".

Improve this answer
Sign up to request clarification or add additional context in comments.

1 Comment

@vivi11130704 re-read the first sentence of this answer, out loud.
1

Your best bet would be to log the protected files, go back and manually unlock them, save a copy, then re-run those specific files.

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
Improve this answer

6 Comments

I've rewritten the answer to match the new question, but it's mostly just a rehash of what Mat said. I do not see an exposed method to unlock the project so to do this pragmatically would take some fancy FilesystemObject work to do the manual DPB= value replacement as described here ExternaLink, but really at that point you'd have to ask yourself if it's worth the trouble.
Moreover since I haven't actually done it yet, it may lead to a dead end when you try to open the externally modified WB.
VBProject.Protection is an vbext_ProjectProtection enum value defined in the VBIDE extensibility library, not the Excel object model: if xlYes works, it's a fluke. The correct value is vbext_pp_locked or vbext_pp_none, which happen to have underlying values of 1 and 0, respectively (i.e. xlYes works for vbext_pp_locked, but only because of its underlying value of 1).
@Mat'sMug it's not a fluke I checked it to make sure it matched before I used it because xlYes works without having to go find where VBIDE lives and including that reference (in my case Microsoft Visual Basic for Applications Extensibility5.3)
I know it works. xlBelow, xlBoth, xlClassic1 and about 2000 other values would have worked as well. Just saying it's misleading. If wb.VBProject.Protection = 1 Then ' 1: vbext_pp_locked would be more appropriate IMO. Also since you're going to have to allow programmatic access to the VBIDE extensibility anyway for this code to work, might as well early-bind the stuff and use the real deal. But whatever.
|

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.