Suppress open events when using Workbooks.Open

[dircur]

I am not a programmer but.
I have built a sub that prompts the user for a folder then opens every workbook in the folder 1 at a time to get stats on the contents of each workbook. Worked like a dam until I ran into an unexpected bug. Some of the users built on open events in their workbooks. ... UHG so you may be able to guess what happened.
Right now my routine inventories workbooks to get formula counts, cell counts, most complex formula, highest value... it does this by looping throught the sheets and the cells. If there is a way of obtaining those stats without opening the workbook I may need to rethink a lot of my work.
My hope is that there is a way to suppress the code in the target workbook I open through workbooks.open
please help.
Thanks

 

[ChrisM]

can't you just click to disable macros when each workbook opens?

 

[dircur]

Unfortunately no. I suppressed the alerts so I would not be prompted during the process, it inventories 500 plus books, but your suggestion leads me to believe there may be a way to set the do not run code in the open method. I will report back if I find anything otherwise this is still unsolved.

 

[Norie]

Have you tried this?

Application.EnableEvents = False
 
' code to open workbooks and do whatever
 
Application.EnableEvents = True

 

[dircur]

No I'll try. I also just found the Application.AutomationSecurity Property in MSDN that i will investigate as well.
And thanks to both of you

 

[Zack Barresse]

Not AutomationSecurity, it is the EnableEvents which will NOT fire events (i.e. the open event of a workbook code module) when it is triggered. Use the EnableEvents as shown by Norie.

 

[dircur]

Well, neither seemed to solve my issue. I keep hitting files with open events that end up launching. I have never posted this much code before so, before the flame war begins I do not profess to be a programmer. You will see I did put in the AutomationSecurity code. I have commented it in and out to see if it made a difference. Thank you all, for taking the time you have to look at this. I have included all functions and such i fear posting it may just kill the tread. when I run this code I get exactly what I want and need. I have also narrowed it down to 2007 macro files. previous version excel files with on open events dont execute so maybe I am on the wirng path.

Public DOFileName As Dictionary
Public DOFileSize As Dictionary
Sub GetFlDetails()
'As a path must be unique, for both dictonary objects we will use the file path as the key
Set DOFileName = CreateObject("Scripting.Dictionary")
Set DOFileSize = CreateObject("Scripting.Dictionary")
Set DOExFileName = CreateObject("Scripting.Dictionary")
Set DOExFileSize = CreateObject("Scripting.Dictionary")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim Folder2E
Dim strComputer
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
'Dim secAutomation As MsoAutomationSecurity
VBACodeStart = ActiveWorkbook.VBProject.VBComponents.VBE.CodePanes.Count
'**PROMPT FOR FOLDER PATH
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                Folder2E = vrtSelectedItem
            Next vrtSelectedItem
        Else
        End If
    End With
    Set fd = Nothing
    On Error GoTo 0
'**GET RECURSIVE FILE DETAILS FOR ALL FILES
    ShowSubFolders objFSO.GetFolder(Folder2E)
 
'**SEARCH FOR EXCEL FILES TO LOAD INTO EXCEL FILE DICTIONARIES
    ColFlPaths = DOFileName.Keys
    'MsgBox ("The routine found " & DOFileName.Count & " files in the folder?")
    For Each FlPath In ColFlPaths
        'MsgBox (FlPath)
        If InStr(1, DOFileName.Item(FlPath), ".xl", vbTextCompare) > 0 Then 'Excel File Found
            DOExFileName.Add FlPath, DOFileName.Item(FlPath)
            DOExFileSize.Add FlPath, DOFileSize.Item(FlPath)
        End If
    Next
 
'*** Update this to give the user an out
'MsgBox ("The routine found " & DOExFileName.Count & " excel files in the folder?")
'*** Bail out After reading how many files and the estimated time the user may wish to bail
Proceed = MsgBox("The routine found " & DOExFileName.Count & " excel files in the folder, and estimates it will take " & _
                   Round(DOExFileName.Count * 0.72243346 / 60, 0) & " minutes to complete (if the folder is Local)?" & vbCrLf & _
                   "If these files are on a network share please consider first copying the folder locally and then running the scan from there." & _
                   "this routine literally opens the files being scanned impacting anyone else useing the file." & vbCrLf & "Press OK to proceed?", vbOKCancel, "Do you wish to proceed?")
Application.ScreenUpdating = False
StartTime = Timer
If Proceed = vbOK Then
    Range("B7").Select
    i = 0
   secAutomation = Application.AutomationSecurity     'get current for later
    Application.AutomationSecurity = msoAutomationSecurityForceDisable
    For Each ExcelFile In DOExFileName.Keys
        i = i + 1
        Application.StatusBar = "Processing files...  " & Round(i / DOExFileName.Count * 100, 0) & " % Complete"
        ActiveCell.Value = i
        ActiveCell.Offset(0, 1).Value = DOExFileName.Item(ExcelFile)
        ActiveCell.Offset(0, 2).Value = ExcelFile
        ActiveCell.Offset(0, 5).Value = DOExFileSize.Item(ExcelFile)
        'MsgBox stFileName
        stPassingFileName = Replace(ExcelFile, "\", "\\")
        Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
            Set colFiles = objWMIService.ExecQuery _
               ("SELECT * FROM CIM_Datafile WHERE Name = '" & stPassingFileName & "'")
        BooksProcessed = BooksProcessed + 1
        Dim SheetFormulasRange As Range
        Dim SheetConstantRange As Range
        File1 = ActiveWorkbook.Name
        Application.DisplayAlerts = False
       Application.EnableEvents = False
       On Error Resume Next
       Workbooks.Open FileName:=ExcelFile
        If Err.Number <> 0 Then
            ActiveCell.Offset(0, 3).Value = "Open Error"
            ActiveCell.Offset(1, 0).Select
            Err.Clear
            On Error GoTo 0
        Else
            On Error GoTo 0
              Application.DisplayAlerts = True
              File2 = ActiveWorkbook.Name
              Formcount = 0
              ConstCount = 0
              ConstNumCount = 0
              FSheetCount = 0
              CSheetCount = 0
              OccupiedSheets = 0
              AvgFormLen = 0
              CumValue = 0
              MaxCalsht = 0.0001
              MaxCalBok = 0
              MaxConBok = 0
              MaxConSht = 0
              MaxFormlen = 0
              LongestForm = "'"
              ExternalReferences = "No"
              VBACode = "No"
              Test4Ref = "No"
              stAuthor = ""
              For Each Sheet In Worksheets
                   On Error Resume Next
                   Set SheetFormulasRange = Sheet.Cells.SpecialCells(xlCellTypeFormulas)
                   FSheetCount = SheetFormulasRange.Count
                   'FSheetCount = Sheet.Cells.SpecialCells(xlCellTypeFormulas).Count
                     If Err.Number <> 0 Then
                       FSheetCount = 0
                       Err.Clear
                     Else
                       Formcount = Formcount + FSheetCount
                       'MaxCalSht = Application.Max(SheetFormulasRange)
                       If MaxCalsht > MaxCalBok Then
                          MaxCalBok = MaxCalsht
                       End If
                       MaxCalsht = 0
                       For Each Cell In SheetFormulasRange
                           SnglFormLen = operatorCount(Cell.Formula)
                           AvgFormLen = AvgFormLen + SnglFormLen
                           Test4Ref = extRef(Cell.Formula)
                           If Test4Ref = "Yes" Then
                                ExternalReferences = "Yes"
                           End If
                           If IsNumeric(Cell.Value) = True Then
                                CumValue = CumValue + Cell.Value
                           End If
                           If IsNumeric(Cell.Value) = True And Cell.Value > MaxCalsht Then
                                MaxCalsht = Cell.Value
                                If MaxCalsht > MaxCalBok Then
                                    MaxCalBok = MaxCalsht
                                End If
                           End If
                           If SnglFormLen > MaxFormlen Then
                              MaxFormlen = SnglFormLen
                              LongestForm = "'" & Cell.Formula
                           End If
                       Next
                       MaxCalsht = 0
                     End If  'This if tested whether the formula count was 0
                   Set SheetConstantRange = Sheet.Cells.SpecialCells(xlCellTypeConstants, 1)
                   CSheetCount = SheetConstantRange.Count
                     If Err.Number <> 0 Then
                       CSheetCount = 0
                       Err.Clear
                     Else
                       ConstCount = ConstCount + CSheetCount
                       For Each Cell In SheetConstantRange
                           Err.Clear
                           TestVal = Cell.Value + 0
                           If IsNumeric(TestVal) = True Then
                                ConstNumCount = ConstNumCount + 1
                                CumValue = CumValue + Cell.Value
                                If Cell.Value > MaxConSht Then
                                     MaxConSht = Cell.Value
                                     If MaxConSht > MaxConBok Then
                                         MaxConBok = MaxConSht
                                     End If
                                End If
                           End If
                       Next
                       MaxConSht = 0
                     End If ' This is the if testing whether the constant count was 0
                     If CSheetCount + FSheetCount > 0 Then
                        OccupiedSheets = OccupiedSheets + 1
                     End If
                    FSheetCount = 0
                    CSheetCount = 0
                    Err.Clear
                   On Error GoTo 0
                Next
                'VBACode = Workbooks(File2).VBProject.VBComponents.VBE.CodePanes.Count - VBACodeStart
                Err.Clear
                On Error Resume Next
                VBAAfter = Workbooks(File2).VBProject.VBComponents.VBE.CodePanes.Count
                If Err.Number <> 0 Then
                    VBAAfter = VBACodeStart + 3
                    Err.Clear
                End If
                On Error GoTo 0
 
                If VBAAfter - VBACodeStart = 0 Then
                    VBACode = "No"
                Else
                    VBACode = "Yes"
                End If
                stAuthor = ActiveWorkbook.BuiltinDocumentProperties("Author").Value
                Application.DisplayAlerts = False
                ActiveWorkbook.Close
                Application.EnableEvents = True
                Application.DisplayAlerts = True
 
                Workbooks(File1).Activate
                ActiveCell.Offset(0, 6).Value = Formcount
                ActiveCell.Offset(0, 7).Value = ConstNumCount
                ActiveCell.Offset(0, 8).Value = ConstCount
                ActiveCell.Offset(0, 9).Value = OccupiedSheets
                ActiveCell.Offset(0, 10).Value = MaxCalBok
                ActiveCell.Offset(0, 11).Value = MaxConBok
                ActiveCell.Offset(0, 12).Value = MaxFormlen
                ActiveCell.Offset(0, 13).Value = LongestForm
                If Formcount = 0 Then
                    ActiveCell.Offset(0, 14).Value = "NA"
                Else
                    ActiveCell.Offset(0, 14).Value = Round(AvgFormLen / Formcount, 0)
                End If
                If Formcount + ConstNumCount = 0 Then
                    ActiveCell.Offset(0, 15).Value = "NA"
                Else
                    ActiveCell.Offset(0, 15).Value = Round(CumValue / (Formcount + ConstNumCount), 0)
                End If
                ActiveCell.Offset(0, 16).Value = Round(CumValue, 0)
                ActiveCell.Offset(0, 17).Value = ExternalReferences
                ActiveCell.Offset(0, 18).Value = VBACode
                ActiveCell.Offset(0, 19).Value = stAuthor
                ActiveCell.Offset(1, 0).Select
                Err.Clear
        End If 'Ending IF workbook open failed
    Next  'ExcelFile in the collection of
   Application.AutomationSecurity = secAutomation
    FinishTime = Timer
    MsgBox ("The routine has completed the review." & vbCrLf & "Runtime = " & Round((FinishTime - StartTime) / 60, 0) & "Min")
    Application.StatusBar = False
End If 'this was the if statement allowing the user to cancel
End Sub
 
Sub GetFileDetails(Folder)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim stFilePath As String
    Dim stFileName As String
    Dim NmFileSize
    Set objFolder = objFSO.GetFolder(Folder)
    Set colFiles = objFolder.Files
    For Each objFile In colFiles
        NmFileSize = objFile.Size
        stFilePath = objFile.Path
        stFileName = objFile.Name
        DOFileName.Add stFilePath, stFileName
        DOFileSize.Add stFilePath, NmFileSize
     'Wscript.Echo objFile.Name, objFile.Size
    Next
End Sub
 
Sub ShowSubFolders(Folder)
 For Each Subfolder In Folder.SubFolders
    ShowSubFolders Subfolder
    GetFileDetails (Subfolder)
 Next
End Sub
Public Function operatorCount(stformula As String)
    toperatorCount = 0
    For x = 1 To Len(stformula)
        If Mid(stformula, x, 1) = "(" Then                 '5 points per function (3 for the function and 2 for the first arguement)
            toperatorCount = toperatorCount + 5
        ElseIf Mid(stformula, x, 1) = "[" Then             '10 points per external reference
            toperatorCount = toperatorCount + 10
        ElseIf Mid(stformula, x, 1) = "," Then             '2 points per arguement
            toperatorCount = toperatorCount + 2
        ElseIf Mid(stformula, x, 1) = "!" Then             '3 points per OffSheet Reference
            toperatorCount = toperatorCount + 3
        ElseIf Mid(stformula, x, 1) = ":" Then             '1 extra point for a range arguement
            toperatorCount = toperatorCount + 1
        ElseIf Mid(stformula, x, 1) = "{" Then             '5 points for an array function
            toperatorCount = toperatorCount + 5
        ElseIf Mid(stformula, x, 1) = "+" Then             '1 point per operator
            toperatorCount = toperatorCount + 1
        ElseIf Mid(stformula, x, 1) = "-" Then             '1 point per operator
            toperatorCount = toperatorCount + 1
        ElseIf Mid(stformula, x, 1) = "*" Then             '1 point per operator
            toperatorCount = toperatorCount + 1
        ElseIf Mid(stformula, x, 1) = "/" Then             '1 point per operator
            toperatorCount = toperatorCount + 1
        ElseIf Mid(stformula, x, 1) = "^" Then             '1 point per operator
            toperatorCount = toperatorCount + 1
        End If
    Next x
    operatorCount = toperatorCount
End Function
Public Function extRef(stformula As String)
    toperatorCount = 0
    Found = "No"
    For x = 1 To Len(stformula)
        If Mid(stformula, x, 1) = "[" Then                 '5 points per function (3 for the function and 2 for the first arguement)
            Found = "Yes"
        End If
    Next x
    extRef = Found
End Function
Public Function FormCmplxty(stformula As Range)
    toperatorCount = 0
    string2analyze = stformula.Formula
    For x = 1 To Len(string2analyze)
        If Mid(string2analyze, x, 1) = "(" Then                 '5 points per function (3 for the function and 2 for the first arguement)
            toperatorCount = toperatorCount + 5
        ElseIf Mid(stformula, x, 1) = "[" Then                  '10 points per external reference
            toperatorCount = toperatorCount + 10
        ElseIf Mid(stformula, x, 1) = "!" Then                  '3 points per OffSheet Reference
            toperatorCount = toperatorCount + 3
        ElseIf Mid(string2analyze, x, 1) = "," Then             '2 points per arguement
            toperatorCount = toperatorCount + 2
        ElseIf Mid(string2analyze, x, 1) = ":" Then             '1 extra point for a range arguement
            toperatorCount = toperatorCount + 1
        ElseIf Mid(string2analyze, x, 1) = "{" Then             '5 points for an array function
            toperatorCount = toperatorCount + 5
        ElseIf Mid(string2analyze, x, 1) = "+" Then             '1 point per operator
            toperatorCount = toperatorCount + 1
        ElseIf Mid(string2analyze, x, 1) = "-" Then             '1 point per operator
            toperatorCount = toperatorCount + 1
        ElseIf Mid(string2analyze, x, 1) = "*" Then             '1 point per operator
            toperatorCount = toperatorCount + 1
        ElseIf Mid(string2analyze, x, 1) = "/" Then             '1 point per operator
            toperatorCount = toperatorCount + 1
        ElseIf Mid(string2analyze, x, 1) = "^" Then             '1 point per operator
            toperatorCount = toperatorCount + 1
        End If
    Next x
    FormCmplxty = toperatorCount
End Function
Function FileFound(FileName)
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(FileName) Then
   FileFound = "Found"
Else
   FileFound = "Not Found"
End If
End Function

 

[Norie]

Eh, what 'flame wars'.

Your probably more likely to get grief for not posting all the code.

Mind you an explanation in words often helps.

Anyways I don't quite see why turning off events wouldn't work.

How exactly have/where are these open events been located?

Could they perhaps be Autpen macros rather than Workbook_Open events?

PS I've never actually heard of AutomationSecurity and can find no reference to it in my ancient copy of Excel.

 

[dircur]

OK so I may have narrowed this down some. In my last post I narrowed it down to xlsm files. I confirmed that in all my testing (with last years files) this bug did not come up. None of those files were office 2007 files. One of the stats I collect is the use of vba code. I enumerate the number of modules. In order to do that I needed to set the "Trust Access to the VBA project object model" flag in trust center options. Could this be somehow overriding?

 

[dircur]

I didnt think anyone was flamming me so sorry if I made it sound that way, I really do appreciate the help I am getting. I know my code is pretty hackish. So I wanted to be preemptive. When i look at the code the admins post, it is .. pretty whereas mine is ... less.

Auto_open? presuming that is the culpret where would I look? and is there a way to suppress them?