Question

我目前有代码查看我指定的每个文件夹并打开最新的Excel电子表格，打开它，打印它，然后关闭它。但是，有超过50个文件夹，我想知道，而不是50个文件夹50次粘贴此代码...有没有办法让它看起来在这些文件夹中，并为每个文件夹做同样的事情？到目前为止，我已经指定了2个文件夹，并为每个文件夹粘贴了整个代码...

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

Answer 1

假设您在Excel中执行此操作。在工作簿中，创建一个名为＆＃34; FolderPaths＆＃34;的新工作表。（或者其他的东西）。在此工作表上，从单元格A1开始，列出文件夹路径，每行一个，下至A50或您需要的数量。

创建此子例程，该子例程将遍历包含文件路径的单元格范围，并将每个路径发送到OpenLatestFile过程：

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

在现有的宏中，摆脱Dim MyPath as String并摆脱MyPath = **"\\address to folder here\"**，然后您还需要MyPath作为此过程的参数：

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

VBA代码在多个文件夹中打开最新文件

1 个答案: