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
No comments:
Post a Comment
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.