I'm attempting to iteratively open every Excel file in a selected folder and then run a series of subroutines on each file. I originally developed the macro (lazily named Main) that opens a single file and performs the appropriate actions - this sub works just fine as far as I can tell.
I'm now working on building a sub called FolderPicker that will open each file in a selected folder and then run the Main sub.
Currently, I have this code, adapted from https://www.thespreadsheetguru.com/the-code-vault/2014/4/23/loop-through-all-excel-files-in-a-given-folder
Sub FolderPicker()
Dim wb As Workbook
Dim myPath As String
Dim MyFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
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 = "*.xls*"
'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)
vFileName = myPath & MyFile
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'Run main sub
main
'Ensure main has completed
DoEvents
'Save and Close Workbook
wb.Activate
wb.Close savechanges:=False
'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
The beginning of this macro runs just fine, the folder dialog box works, and it opens the first file. However, the MyFile = Dir line directly proceeding Loop doesn't seem to be working - it evaluates to a null value and then the sub ends. I've verified that there are multiple files in the folder.
For reference, vFileName is a publicly declared variant that's used in Main.
Any suggestions?
You cannot use nested Dir() loops, so if main also uses Dir() then you'll need to take a different approach, such as adding all the matches from the outer Dir() to a Collection and then looping over that to call main on each match.
Related
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"
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.
I use the following code to loop through the files in the folders, open the file and then wait for data to load and save and stop. however, it keeps repeating the loop. That is, after the last file, it starts again with the first file and keeps looping. What is wrong?
Sub morningstar_open_and_save_only_VBA()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim filename As String
Dim path_to_save As String
Dim FldrPicker As FileDialog
Dim w As Long
Dim StartTime As Double
Dim SecondsElapsed As Double
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
Application.ScreenUpdating = False
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 = "*.xlsx*"
'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)
Set cmd = Application.CommandBars("Cell").Controls("Refresh All")
cmd.Execute
'Ensure Workbook has opened before moving on to next line of code
wb.Close savechanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
SecondsElapsed = Round(Timer - StartTime, 2)
'Message Box when tasks are completed
MsgBox "Task Complete! in " & SecondsElapsed & " seconds"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Just made some research , I guess you can adpat the code from another post (see link : Get list of Excel files in a folder using VBA)
You can adapt the loop to your need and it's more elegant !
For Each oFile In oFiles
Next
I hope it help ! Take care !
I'm trying to save time in looking for excel files without a specific sheet named "RUNREADY" in a large directory of nested folders and excel files. This workbook without the worksheet would ideally be listed in a master excel file higher up in the directory or just have its name changed to end in a '(1)' or '(0)' depending on if it has the sheet or not.
Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
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 = "*.xls*"
'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
Dim ws As Worksheet
Dim rr As Integer
Dim cel As Range
rr = 0
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "RUNREADY" Then
rr = rr + 1
Else
rr = 0
End If
Next ws
If rr = 1 Then
[RUNREADY.xlsm] Sheet1!cel.Value = ActiveWorkbook.FullName
[RUNREADY.xlsm] Sheet1!cel.Offset(1, 0)
End If
'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
I looked around for some sort of guidance and found this piece of code that searches through a file. I tried to write something that would write to a named excel file. my portion is spaced off in the middle of everything Running this i get an error at the first square bracket in my portion of code.
I have been building a macro to loop through a series of files in a folder and with each one copy and paste data into a series of other sheets in another folder. I started with this code below which worked fine doing the copy and pasting:
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
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 = "*.xls*"
'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
However I've now added a second loop to deal with the multiple to multiple files and I'm getting a run time error 5 on the second version of:
myFile = Dir
I've renamed myFile to another name so it doesn't conflict with the first.
I've not posted all my code here as it's much longer and more complicated. Hope this is enough for you guys to go on?
You cannot achieve that with the Dir() Function. To do that you can use Scripting.FileSystemObject.
This is a sample I wrote that you can easily adapt to your code:
Dim oFile As Object
Dim oFSO As Object
Dim oFolder As Object
Dim oFiles As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(myPath) 'You must initialize this before
Set oFiles = oFolder.Files
'For all files in the folder
For Each oFile In oFiles
If (oFile Like "*.xls*") Then
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=oFile)
'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
End If
Next
Hope this helps.
Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
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 = "*.xls"
'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
'Press button in sheet 51
wb.Worksheets("51").CommandButton1.Value = True
'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
I have a folder with 50 workbooks with the same worksheets in each workbook. I have 2 buttons in each of the worksheets in the workbook that allows me to download/upload to db. I need to loop through each workbook and have it press the upload button in sheet51.
wb.Worksheets("51").CommandButton1.Value = True
Can anyone look through what I'm doing wrong? I'm getting this message -- Run-time error: '438': Object doesn't support this property or method.
CommandButtons don't have a Value property, so I think you want to invoke the button's Click event, i.e.:
wb.Worksheets("51").CommandButton1_Click
The CommandButton1_Click event will first need to be declared Public, rather than Private, i.e.:
Public Sub CommandButton1_Click()
While it is declared Private, it can only be accessed by code within the worksheet itself.
The following edit, for which I am very grateful, was made by Comintern:
NOTE: If you don't want to manually change all of the event handler routines, you can simply change them from Private to Public by using VBA Extensibility:
'Requires a reference to Microsoft Visual Basic for Applications Extensibility
'Also requires "Trust access to the VBA project object model" to be checked.
'in Macro Security.
Dim targetLine As Long
'The "51" in VBComponents("51") is the name of the code module which is usually, but
'not always, the same as the sheet name
With wb.VBProject.VBComponents("51").CodeModule
targetLine = .ProcStartLine("CommandButton1_Click", vbext_pk_Proc)
.ReplaceLine targetLine, "Public Sub CommandButton1_Click()"
End With
wb.Sheets("51").CommandButton1_Click