VBA Excel 循环遍历同目录下的all.xslm文件

Question

Good afternoon,

I would like to check all files in my directory. For this purpose, I decided to loop through all of them.

The good code I found here:

https://www.thespreadsheetguru.com/the-code-vault/2014/4/23/loop-through-all-excel-files-in-a-given-folder

and changed it consequently for my personal purpose.

 Sub LoopAllExcelFilesInFolder()

 Dim wb As Workbook
 Dim myPath As String
 Dim myFile As String
 Dim myExtension As String
 Dim FldrPicker As FileDialog

 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.Calculation = xlCalculationManual

Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
  .Title = "Select A Target Folder"
  .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & "\"
End With

 'In Case of Cancel
 NextCode:
 myPath = myPath
  If myPath = "" Then GoTo ResetSettings

 'Target File Extension (must include wildcard "*")
  myExtension = "*.xlsm*"

 'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

  'Loop through each Excel file in folder
   Do While myFile <> ""
  'Set variable equal to opened workbook
    Set wb = Workbooks.Open(Filename:=myPath & myFile)

'Ensure Workbook has opened before moving on to next line of code
  DoEvents

'Change First Worksheet's Background Fill Blue
  wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)

'Save and Close Workbook
  wb.Close SaveChanges:=True
  
'Ensure Workbook has closed before moving on to next line of code
  DoEvents

'Get next file name
  myFile = Dir
   Loop

'Message Box when tasks are completed
 MsgBox "Task Complete!"

  ResetSettings:
 'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

  End Sub

but it looks like the code works for the first file only.

I am not only one with this problem, because I found the similar problems here:

VBA Loop through excel workbooks in folder and copy data - Not looping through all files

Excel-VBA Loop not looping through all files in folder

Is there a way to make this code working for all files instead of one?

or should I use better For Each instead of Do While?

My problem is very similar to this issue:

Code Stopping While Looping through files on workbook.close

the new file is not prompted at all. In my VBA console is "no project selected"

Answer 1

I have seemingly the same code and it works fine.

When i pickup some code somewhere i tend to make small changes step by step and make sure its still working every change i make.

 Sub LoopThroughFilesvieux()

        Dim xFd As FileDialog
        Dim xFdItem As Variant
        Dim xFileName As String
        Dim xWB As Workbook

        Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
        If xFd.Show = -1 Then

        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")

        On Error Resume Next
        Do While xFileName <> ""

          Set xWB = Workbooks.Open(xFdItem & xFileName)
          With xWB

'yourcode

          End With
    xWB.Close
    xFileName = Dir
    Loop
    End If
    End Sub

You can probably start again from my structure or the original structure you took that from and add your code lines little by little, also, try to run it step by step to see where it exits.