How to Loop through all Excel[.xls] files in a Folder using VBA
Sub Loop_Through_Xls_Files()
Dim SourcePath As String
Dim SourceFolder As Object
Dim SrcFile As String
Dim My_WB As Object
Dim MyXlFiles() As String
Dim FSO As Object
Dim K As Integer
Application.DisplayAlerts = False
K = 1
'To Select the Target Folder by Opening the File Dialogue Box
Set Flder_Picker = Application.FileDialog(msoFileDialogFolderPicker)
With Flder_Picker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub 'Exit if we don't select a Folder
MyPath = .SelectedItems(1) & "\"
End With
MsgBox MyPath
'Loop through each Excel File in the Target Folder and Storing in an Array
Set FSO = CreateObject("Scripting.FileSystemObject")
SourcePath = MyPath
Set SourceFolder = FSO.GetFolder(SourcePath)
For Each File In SourceFolder.Files
If InStr(File.Name, ".xls") Then
ReDim Preserve MyXlFiles(K)
MyXlFiles(K) = File.Name
K = K + 1
End If
Next File
'Loop through specific Excel Files , Opening , Performing an Operation and Closing, from the SourcePath
SrcFile = Dir(SourcePath & "SQL*.xls")
Do While SrcFile <> ""
Set My_WB = Workbooks.Open(SourcePath & SrcFile, UpdateLinks:=False, ReadOnly:=True, Editable:=True)
' Your Macro operation here
MsgBox SrcFile 'My_WB.Name
My_WB.Close
SrcFile = Dir() 'Allows to Go to Next File in a Directory
Loop
End Sub
Thanks, TAMATAM
Sub Loop_Through_Xls_Files()
Dim SourcePath As String
Dim SourceFolder As Object
Dim SrcFile As String
Dim My_WB As Object
Dim MyXlFiles() As String
Dim FSO As Object
Dim K As Integer
Application.DisplayAlerts = False
K = 1
'To Select the Target Folder by Opening the File Dialogue Box
Set Flder_Picker = Application.FileDialog(msoFileDialogFolderPicker)
With Flder_Picker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub 'Exit if we don't select a Folder
MyPath = .SelectedItems(1) & "\"
End With
MsgBox MyPath
'Loop through each Excel File in the Target Folder and Storing in an Array
Set FSO = CreateObject("Scripting.FileSystemObject")
SourcePath = MyPath
Set SourceFolder = FSO.GetFolder(SourcePath)
For Each File In SourceFolder.Files
If InStr(File.Name, ".xls") Then
ReDim Preserve MyXlFiles(K)
MyXlFiles(K) = File.Name
K = K + 1
End If
Next File
'Loop through specific Excel Files , Opening , Performing an Operation and Closing, from the SourcePath
SrcFile = Dir(SourcePath & "SQL*.xls")
Do While SrcFile <> ""
Set My_WB = Workbooks.Open(SourcePath & SrcFile, UpdateLinks:=False, ReadOnly:=True, Editable:=True)
' Your Macro operation here
MsgBox SrcFile 'My_WB.Name
My_WB.Close
SrcFile = Dir() 'Allows to Go to Next File in a Directory
Loop
End Sub
Thanks, TAMATAM