Programmatically "pushing buttons" when opening a workbook

[Dr. Demento]

Hey folks! Happy New Year!

I'm working on a sub that will loop thru folders/subfolders, open each file, and list the sheets in each file. However, I'm running into issues for files that are .xlsm or are password protected. Rather than click each time one of these files come's up, I'd like to programmatically click the appropriate button (Enable Macros for .xlsm files, and Cancel for password protected files).

Due to Admin requirements, I can't globally allow Enable Macros. I realize that the code below doesn't print (the sub I use is rather involved).

Thoughts?? Thanks y'all.

Sub list_AllShtInFolder()
' ~~ Loop through every file in folder and list all sheet names
' [URL]https://www.mrexcel.com/forum/excel-questions/663583-loop-through-every-file-folder-list-all-sheet-names.html#5[/URL]
' ~~ Cycle through sub-folders and files in a user-specified root directory
' [URL]https://stackoverflow.com/a/22646086[/URL] || [URL]https://stackoverflow.com/questions/22645347/loop-through-all-subfolders-using-vba[/URL]
Const proc_name = "list_AllShtInFolder"

Dim fso As Object 'FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject") ' late binding
Dim Fldr As Object, _
    subFldr As Object, _
    Fl As Object
    
Dim queue As Collection
  Set queue = New Collection

Dim arr As Variant
  ReDim arr(1 To 1000000, 1 To 3)
  arr(1, 1) = "Path": arr(1, 2) = "File": arr(1, 3) = "Worksheet"
  
Dim wbkDest As Workbook, _
    wbk As Workbook
  Set wbkDest = ActiveWorkbook
Dim shtDest As Worksheet, _
    sht As Worksheet
  Set shtDest = ActiveSheet
Dim filetype As String
  filetype = "*.xlsx"     'The file type to search for
  
Dim i As Long, _
    j As Long  ' ~~ File counter
  i = 2   'The first row of the active sheet to start writing to
  
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = wbkDest.path
    .AllowMultiSelect = False
    If .Show = -1 Then
      queue.Add fso.GetFolder(fso.GetFolder(.SelectedItems(1) & ""))  ' ~~ Starting Folder
    Else
      Exit Sub  'Cancel was pressed
    End If
  End With '.FileDialog
  
  
  Do While queue.Count > 0
    Set Fldr = queue(queue.Count)
    queue.Remove (queue.Count) 'dequeue
    '...insert any folder processing code here...
    
    For Each subFldr In Fldr.SubFolders
      queue.Add subFldr 'enqueue
    Next subFldr
    
    For Each Fl In Fldr.Files
      If Fl.name Like filetype Then
        ' ...insert any file processing code here...
        
        On Error Resume Next
        
        Set wbk = Workbooks.Open(Fl, UpdateLinks:=False, ReadOnly:=True)

        j = j + 1

        If Not wbk Is Nothing Then
          For Each sht In wbk.Sheets
            arr(i, 1) = Fldr & ""
            arr(i, 2) = wbk.name
            arr(i, 3) = sht.name
            i = i + 1
          Next sht
          wbk.Close SaveChanges:=False

        Else
          arr(i, 1) = Fldr & ""
          arr(i, 2) = wbk.name
          arr(i, 3) = "Unable to access workbook"
          i = i + 1
        End If 'wbk <> Nothing
        On Error GoTo 0
        
      End If 'Fl.name
    Next Fl
  Loop 'queue.Count
 
End Sub

 

[NdNoviceHlp]

Dim filetype As String
  filetype = "*.xlsx"     'The file type to search for
Dim filetype2 As String
  filetype2 = "*.xlsm"     'The 2nd file type to search for
If Fl.name Like filetype or  Fl.name Like filetype2 Then

Maybe...

Application.displayalerts=False
wbk.Close SaveChanges:=False
application.displayalerts=True

HTH. Dave

 

[Dr. Demento]

Dave,

Thank you for the reply. I did forget to update the filetype; in my latest version, filetype = "*.xls*" which allows for all various Excel filetypes.

Apologies, but I didn't explain myself very well. The issue isn't upon Close, but when the file Opens. I have turned off DisplayAlerts and these alerts still display. Given that they are asking about passwords or enabling macros, I don't think the alerts can be suppressed. I'm looking for a way to programmatically either Cancel opening the password protected document or Enabling Macros when the file opens.

Any additional thoughts?? Thanks much.

 

[NdNoviceHlp]

You can't open a password protected file if U don't know the password. If U know the password, U can code it by changing the "Fake Password" to the real password in the following code. If U don't know it, U can skip the file by providing the "Fake Password" and then identifying the error 1004 that it produces. Here's the piece of your relevant code. Note that I have made some adjustments to your array stuff. HTH. Dave

Option Explicit
Option Base 1

Sub tester()
Dim fso As Object, Fldr As Object, Fl As Object, i As Integer, Arr() As Variant
Dim J As Integer, wbk As Workbook, sht As Worksheet, cnt As Integer
Set fso = CreateObject("scripting.filesystemobject")
'***change Folder name (ie.Datafiles) to your folder name
Set Fldr = fso.GetFolder(ThisWorkbook.Path & "\Datafiles")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Fl In Fldr.Files
If Fl.Name Like "*.xls*" Then
' ...insert any file processing code here...
On Error Resume Next
Set wbk = Workbooks.Open(Fl, UpdateLinks:=False, ReadOnly:=True, Password:="Fake Password")
If Err.Number = 1004 Then
MsgBox Fl.Name & " is password protected and will not be added to array!"
End If
On Error GoTo 0
If Not wbk Is Nothing Then
J = J + wbk.Sheets.Count
ReDim Preserve Arr(3, J)
For Each sht In wbk.Sheets
i = i + 1
Arr(1, i) = Fldr & ""
Arr(2, i) = wbk.Name
Arr(3, i) = sht.Name
Next sht
wbk.Close SaveChanges:=False
End If
End If 'Fl.name
Set wbk = Nothing
Next Fl
Set Fldr = Nothing
Set fso = Nothing
    'check output
    For cnt = 1 To i
    MsgBox Arr(1, cnt) & "  " & Arr(2, cnt) & "  " & Arr(3, cnt)
    Next cnt
Application.DisplayAlerts = False
Application.ScreenUpdating = True
End Sub

 

[Dr. Demento]

Slick! Thank you; I think that will work nicely. The passwords are all over the map, so purposefully causing an error is the way I'd go.

Any thoughts about a similar solution for the Enable Macros (or Disable -- I don't care) on file open for .xlsm files??

 

[NdNoviceHlp]

Have U tried the code? I don't get any enable macro message when I use it (XL 2016 .xlsm). Dave
note: the code above should have Application.Displayalerts = True (not False) at the end of the sub

 

[Dr. Demento]

Dave,

Thanks much. Because I was using an error handler (On Error GoTo Error_Handler) in my production code, it wasn't throwing error 1004. However, I was able to get the appropriate response when I used the ELSE portion of testing whether the workbook had been successfully set:

 If Not wbk Is Nothing Then
      ReDim arr(1 To wbk.Sheets.Count)
      For i = 1 To wbk.Sheets.Count
        arr(i) = wbk.Sheets(i).Name
      Next i
    Else
      ReDim arr(1)
      arr(1) = "--- Unable to access workbook ---"
      wbk.Close SaveChanges:=False
      Exit Function
    End If 'wbk <> Nothing

As far as the prompt asking to Enable/Disable Macros when each file is opened, I found I only get that prompt repeatedly when I have the VBE open; when VBE is closed, there's no issue.

Thanks again for your help!!

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave