Macro search inconsistent

Hi

The code snippet is used to open a number of spreadsheets and Word documents to ascertain whether they have any Macros. The Excel one works perfectly and reliably. When I test the Word macro, it does not detect documents with macros.

Also attached is a word document with a macro or two (dummy file) that has been used to test with that is not detected

I cannot for the life of me see whyt not. A fresh pair of eyes may help.

Regards


Kelvin
Public Function CheckExcelForMacro(sPath As String, bSub As Boolean, Optional sFile)
On Error GoTo Err_fn

'Dim sSheet As String
Dim oExcel, oXLS, oVBC
Dim secAutomation
Dim db As DAO.Database
Dim rsSheet As DAO.Recordset
Dim rsMacro As DAO.Recordset
Dim bNoted As Boolean
Dim lFileID As Long
Dim lLines As Long
Dim i As Long
Dim dLM As Date




Set db = CurrentDb()
'If Not IsNull(sFile) Then
'    sSheet = Dir(sPath & "\*.xls")
'Else
'    sSheet = Dir(sPath & "\" & sFile)
'End If

With Application.FileSearch
    .LookIn = sPath
    .SearchSubFolders = bSub
    If IsMissing(sFile) Then
        .Filename = "*.xls"
    Else
        .Filename = sFile
    End If
    .Execute
    
    For i = 1 To .FoundFiles.Count
        sFile = Mid(.FoundFiles(i), Len(sPath) + 1)
        dLM = Format(fLastModified(sPath & "\" & sFile), "d-mmm-yyyy")
        Set oExcel = CreateObject("Excel.Application")
        Set oXLS = oExcel.Workbooks.Open(.FoundFiles(i))
        DoCmd.Hourglass True
        DoCmd.Echo False, "Checking Spreadsheet " & .FoundFiles(i)
        
        secAutomation = oExcel.AutomationSecurity
        oExcel.AutomationSecurity = 3
        
        
        bNoted = False
        For Each oVBC In oXLS.vbproject.VBComponents
            
            If (oVBC.CodeModule.Find("sub", 0, 0, 0, 0, True, False) Or _
                    oVBC.CodeModule.Find("function", 0, 0, 0, 0, True, False)) Then
                    If Not bNoted Then
                        Set rsSheet = db.OpenRecordset("tblFiles", dbOpenDynaset)
                        With rsSheet
                            .AddNew
                                !Filepath = sPath
                                !Filename = sFile
                                !FileType = "Excel"
                                !HasMacro = True
                                !LastModified = dLM
                                !ContactPerson = Forms!FileMacroChecker!txtContact
                            .Update
                            .MoveLast
                            lFileID = !FileID
                        End With
                        rsSheet.Close
                        Set rsSheet = Nothing
                        bNoted = True
                    End If
                    
                    Set rsMacro = db.OpenRecordset("tblMacros", dbOpenDynaset)
                    
                    With rsMacro
                        .AddNew
                            !FileID = lFileID
                            !MacroName = oVBC.CodeModule.Name
                            !Lines = oVBC.CodeModule.CountOfLines
                        .Update
                        rsMacro.Close
                        Set rsMacro = Nothing
                    End With
            Else
                If Not bNoted Then
                    Set rsSheet = db.OpenRecordset("tblFiles", dbOpenDynaset)
                    With rsSheet
                        .AddNew
                            !Filepath = sPath
                            !Filename = sFile
                            !FileType = "Excel"
                            !HasMacro = False
                            !LastModified = dLM
                            !ContactPerson = Forms!FileMacroChecker!txtContact
                        .Update
                        .MoveLast
                    End With
                    rsSheet.Close
                    Set rsSheet = Nothing
                    bNoted = True
                End If
            End If
        Next oVBC
        
        oXLS.Close
        Set oXLS = Nothing
        oExcel.Quit
        Set oExcel = Nothing
        
        DoCmd.Echo True
        DoCmd.Hourglass False
    Next i

End With

Exit_fn:
    Exit Function
    
Err_fn:
    MsgBox Err.Number & "; " & Err.Description
    Resume Exit_fn
    
End Function

Public Function CheckWordForMacro(sPath As String, bSub As Boolean, Optional sFile)
On Error GoTo Err_fn

Dim sDoc As String
Dim oWord, oDoc, oVBC
Dim secAutomation
Dim db As DAO.Database
Dim rsDoc As DAO.Recordset
Dim rsMacro As DAO.Recordset
Dim bNoted As Boolean
Dim lFileID As Long
Dim lLines As Long
Dim i As Long
Dim dLM As Date

Set db = CurrentDb()
'If Not IsNull(sFile) Then
'    sDoc = Dir(sPath & "\*.doc")
'Else
'    sDoc = Dir(sPath & "\" & sFile)
'End If

With Application.FileSearch
    .LookIn = sPath
    .SearchSubFolders = bSub
    If IsMissing(sFile) Then
        .Filename = "*.doc"
    Else
        .Filename = sFile
    End If
    .Execute
    
    For i = 1 To .FoundFiles.Count
        sDoc = Mid(.FoundFiles(i), Len(sPath) + 1)
        dLM = Format(fLastModified(sPath & "\" & sDoc), "d-mmm-yyyy")
        
        Set oWord = CreateObject("Word.Application")
        Set oDoc = oWord.Documents.Open(sPath & "\" & sDoc)
        DoCmd.Hourglass True
        DoCmd.Echo False, "Checking Word Document " & sPath & "\" & sDoc
        
        secAutomation = oWord.AutomationSecurity
        oWord.AutomationSecurity = 3
        
        
        bNoted = False
        For Each oVBC In oDoc.vbproject.VBComponents
            
            If (oVBC.CodeModule.Find("sub", 0, 0, 0, 0, True, False) Or _
                    oVBC.CodeModule.Find("function", 0, 0, 0, 0, True, False)) Then
                    If Not bNoted Then
                        Set rsDoc = db.OpenRecordset("tblFiles", dbOpenDynaset)
                        With rsDoc
                            .AddNew
                                !Filepath = sPath
                                !Filename = sDoc
                                !FileType = "Word"
                                !HasMacro = True
                                !LastModified = dLM
                                !ContactPerson = Forms!FileMacroChecker!txtContact
                            .Update
                            .MoveLast
                            lFileID = !FileID
                        End With
                        rsDoc.Close
                        Set rsDoc = Nothing
                        bNoted = True
                    End If
                    
                    Set rsMacro = db.OpenRecordset("tblMacros", dbOpenDynaset)
                    
                    With rsMacro
                        .AddNew
                            !FileID = lFileID
                            !MacroName = oVBC.CodeModule.Name
                            !Lines = oVBC.CodeModule.CountOfLines
                        .Update
                        rsMacro.Close
                        Set rsMacro = Nothing
                    End With
                    
                    DoCmd.Echo True
                    DoCmd.Hourglass False
            Else
                If Not bNoted Then
                    Set rsDoc = db.OpenRecordset("tblFiles", dbOpenDynaset)
                    With rsDoc
                        .AddNew
                            !Filepath = sPath
                            !Filename = sDoc
                            !FileType = "Word"
                            !HasMacro = False
                            !LastModified = dLM
                            !ContactPerson = Forms!FileMacroChecker!txtContact
                        .Update
                    End With
                    rsDoc.Close
                    Set rsDoc = Nothing
                    bNoted = True
                End If
            End If
        Next oVBC
        
        oDoc.Close
        Set oDoc = Nothing
        oWord.Quit
        Set oWord = Nothing
        
    Next i

End With
Exit_fn:
    Exit Function
    
Err_fn:
    MsgBox Err.Number & "; " & Err.Description
    Resume Exit_fn
    
End Function

Function fLastModified(sFile As String) As Date

Dim fs
Dim f

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(sFile)

fLastModified = f.DateLastModified

End Function

Open in new window

Test-with-macro.doc
LVL 23
Kelvin SparksAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

RobOwner (Aidellio)Commented:
Hi,

Doesn't seem to be any macros in that attached document ????

Rob
0
Kelvin SparksAuthor Commented:
If, in Word, I click Tools>Macro>Macros I see two listed. Macro 2 has been assigned to keyboard keys of Alt A
 
 
0
RobOwner (Aidellio)Commented:
Are you sure it's in the word document and not your normal.dot template?
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

Kelvin SparksAuthor Commented:
Ho Rob
Thanks for that one. Yes were in normal.dot.
I have added document Macros and they are still not detected. Revised doc attached
 
Kelvin

Test-with-Macro.xls
0
RobOwner (Aidellio)Commented:
You've attached the Excel spreadsheet - You've said above that your script works reliably with Excel but not Word right?
0
Kelvin SparksAuthor Commented:
Ooops
 
Try again
 
Thanks Kelvin

Test-with-macro.doc
0
RobOwner (Aidellio)Commented:
line 48 is interesting in word:

"For Each oVBC In oXLS.vbproject.VBComponents"

I added on the next line:

"msgbox oVBC.CodeModule.CountOfLines"

In my debugger it went through this loop twice the first time returning "2" lines and the second time "21".  I suspect it looks somewhere first before the main module
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
RobOwner (Aidellio)Commented:
Sorry that was line 170 i was referring to
0
Kelvin SparksAuthor Commented:
Interesting. I have now coded to take this into account - seems to be some component that identified the document.
Have raised a new question around the macros in normal.dot
http://www.experts-exchange.com/Microsoft/Development/MS_Access/Q_25882810.html 
Kelvin
0
Kelvin SparksAuthor Commented:
Got me onto the issue and sorted

Thanks
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.