CODEWITHSUNDEEP
vbaexcel-2010
D Wells
D Wells

Reputation: 1

VBA code to open latest file in multiple folders

I currently have code to look at each folder I have specified and open the latest excel spreadsheet, open it, print it, then close it. However, there are over 50 folders and I am wondering, instead of pasting this code 50 times for 50 folders...is there a way to have it look in these folders and do the same for each folder? I have specified 2 folders so far with pasting the entire code for each folder...

Sub OpenLatestFile()

'Declare the variables
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date

'Specify the path to the folder
MyPath = **"\\address to folder here\"**

'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"

'Get the first Excel file from the folder
MyFile = Dir(MyPath & "*.xls", vbNormal)

'If no files were found, exit the sub
If Len(MyFile) = 0 Then
    MsgBox "No files were found...", vbExclamation
    Exit Sub
End If

'Loop through each Excel file in the folder
Do While Len(MyFile) > 0

    'Assign the date/time of the current file to a variable
    LMD = FileDateTime(MyPath & MyFile)

    'If the date/time of the current file is greater than the latest
    'recorded date, assign its filename and date/time to variables
    If LMD > LatestDate Then
        LatestFile = MyFile
        LatestDate = LMD
    End If

    'Get the next Excel file from the folder
    MyFile = Dir

Loop

'Open the latest file
Workbooks.Open MyPath & LatestFile
ActiveWorkbook.Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
    IgnorePrintAreas:=False
ActiveWorkbook.Close


'Specify the path to the folder
MyPath = "\\address to folder here\"    
'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"

'Get the first Excel file from the folder
MyFile = Dir(MyPath & "*.xls", vbNormal)

'If no files were found, exit the sub
If Len(MyFile) = 0 Then
    MsgBox "No files were found...", vbExclamation
    Exit Sub
End If

'Loop through each Excel file in the folder
Do While Len(MyFile) > 0

    'Assign the date/time of the current file to a variable
    LMD = FileDateTime(MyPath & MyFile)

    'If the date/time of the current file is greater than the latest
    'recorded date, assign its filename and date/time to variables
    If LMD > LatestDate Then
        LatestFile = MyFile
        LatestDate = LMD
    End If

    'Get the next Excel file from the folder
    MyFile = Dir

Loop

'Open the latest file
Workbooks.Open MyPath & LatestFile
ActiveWorkbook.Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
    IgnorePrintAreas:=False
ActiveWorkbook.Close

End Sub

Upvotes: 0

Views: 1763

Answers (1)

David Zemens
David Zemens

Reputation: 53623

Assuming you're doing this in Excel. In your workbook, create a new worksheet called "FolderPaths" (or something). On this sheet, beginning in cell A1, list the folder paths, one in each row, down to A50 or however many you need.

Create this subroutine which will loop over the range of cells containing the file paths, and send each path to the OpenLatestFile procedure:

Sub DoAllTheThings()

Dim MyPath as String
Dim rng as Range
Dim r as Range

Set rng = Worksheets("FolderPaths").Range("A1:A50") 'Modify as needed

For each r in rng.Cells
    MyPath = Trim(r.Value)

    Call OpenLatestFile(MyPath)

Next

End Sub

In your existing macro, get rid of Dim MyPath as String and also get rid of MyPath = **"\\address to folder here\"**, then you also will require MyPath as an argument for this procedure:

Sub OpenLatestFile(MyPath as String)

'Declare the variables
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date

'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"

'Get the first Excel file from the folder
MyFile = Dir(MyPath & "*.xls", vbNormal)

'If no files were found, exit the sub
If Len(MyFile) = 0 Then
    MsgBox "No files were found...", vbExclamation
    Exit Sub
End If

'Loop through each Excel file in the folder
Do While Len(MyFile) > 0

    'Assign the date/time of the current file to a variable
    LMD = FileDateTime(MyPath & MyFile)

    'If the date/time of the current file is greater than the latest
    'recorded date, assign its filename and date/time to variables
    If LMD > LatestDate Then
        LatestFile = MyFile
        LatestDate = LMD
    End If

    'Get the next Excel file from the folder
    MyFile = Dir

Loop

'Open the latest file
Workbooks.Open MyPath & LatestFile
ActiveWorkbook.Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
    IgnorePrintAreas:=False
ActiveWorkbook.Close


'Specify the path to the folder
MyPath = "\\address to folder here\"    
'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"

'Get the first Excel file from the folder
MyFile = Dir(MyPath & "*.xls", vbNormal)

'If no files were found, exit the sub
If Len(MyFile) = 0 Then
    MsgBox "No files were found...", vbExclamation
    Exit Sub
End If

'Loop through each Excel file in the folder
Do While Len(MyFile) > 0

    'Assign the date/time of the current file to a variable
    LMD = FileDateTime(MyPath & MyFile)

    'If the date/time of the current file is greater than the latest
    'recorded date, assign its filename and date/time to variables
    If LMD > LatestDate Then
        LatestFile = MyFile
        LatestDate = LMD
    End If

    'Get the next Excel file from the folder
    MyFile = Dir

Loop

'Open the latest file
Workbooks.Open MyPath & LatestFile
ActiveWorkbook.Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
    IgnorePrintAreas:=False
ActiveWorkbook.Close
End Sub

Upvotes: 1

Related Questions