excel - 如何循环文件夹名称的字符串数组以复制文件并重命名？

Question

以下代码将复制文件并重命名它。

我现在需要将它扩展到我存储在数组中的多个文件夹。该代码正确地复制了第一个文件。

当它尝试打开第二个目录时会出错（我将扩展到 30 多个目录）。似乎循环从中间开始。

出于安全原因，我使用示例变量名和路径。

Sub Coxxxxxxauto()

Dim MyPath As String
Dim MyPath2 As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
Dim xWB As Workbook
   
Dim DateStamp As String
Dim FilePath1 As String
Dim Path1 As String

Dim vJc As Variant
Dim vItem As Variant

Dim Jc1 As String
Dim Jc2 As String

Jc1 = "\\C:\Documents\Newsletters\Eg1****2018"
Jc2 = "\\C:\Documents\Newsletters\Eg2****2018"

vJc = Array(Jc1, Jc2)

DateStamp = "US_" & Format(Date - 1, "YYYY-MM-DD")

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

    'Get the first Excel file from the folder
    MyFile = Dir(MyPath & "*.csv", 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    # Loop starts here on second run
    
    Application.DisplayAlerts = False

    Sheets(1).Select
    Sheets(1).Copy
    Application.DisplayAlerts = False

    'On Error GoTo errHandler
    ActiveWorkbook.SaveAs Filename:=vItem & "\" & _
      Right(vItem, Len(vItem) - InStrRev(vItem, "_")) & "_" & _
      DateStamp, FileFormat:=xlCSV, CreateBackup:=False

    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Application.ScreenUpdating = False
 
    For Each xWB In Application.Workbooks
        If Not (xWB Is Application.ThisWorkbook) Then
            xWB.Close
        End If
    Next
    Application.ScreenUpdating = True

    'MsgBox "Files Published. Check for adjustments.", vbOKOnly, "Spot-On: Alert    "

Next vItem

errHandler:
MsgBox "Existing file Found", vbCritical, "Wait a Minute...We've been here before"
For Each xWB In Application.Workbooks
    If Not (xWB Is Application.ThisWorkbook) Then
        xWB.Close
    End If
Next
 
End Sub

标签： excelvbafor-loop

Answer 1

请尝试以下，我简化了一点你的代码

您的变量“LatestDate”在子开始时声明并且从未重置，因此在循环到达第二个数组位置时，前一个“LastDate”持续存在，如果在第二个文件夹上没有文件具有更高的 filedatetime 然后坚持之前保存的相同，看起来好像跳过了第一个循环。

Sub Coxxxxxxauto()
    
    Application.ScreenUpdating = False
    
    Dim DateStamp As String
    DateStamp = "US_" & Format(Date - 1, "YYYY-MM-DD")
    
    Dim Jc1 As String
    Dim Jc2 As String
    Jc1 = "\\C:\Documents\Newsletters\Eg1****2018"
    Jc2 = "\\C:\Documents\Newsletters\Eg2****2018"

    Dim vJc As Variant
    vJc = Array(Jc1, Jc2)
    Dim vItem As Variant
    
    For Each vItem In vJc
            
            'Make sure that the path ends in a backslash
            Dim MyPath As String: MyPath = vItem
            If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
          
            'Get the first Excel file from the folder
            Dim MyFile As String
            MyFile = Dir(MyPath & "*.xml", vbArchive)
            
            'If no files were found, exit the sub
            If Len(MyFile) = 0 Then: MsgBox "No files were found...", vbExclamation: GoTo NextFolder
        
            'Loop through each Excel file in the folder
            Dim LatestFile As String: LatestFile = ""
            Dim LatestDate As Date: LatestDate = 0
            
            Do While Len(MyFile) > 0
                'Assign the date/time of the current file to a variable
                Dim LMD As Date: 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
            
                'Get the next Excel file from the folder
                MyFile = Dir
            Loop
            
            'Copy
            FileCopy MyPath & LatestFile, vItem & "\" & Right(vItem, Len(vItem) - InStrRev(vItem, "_")) & "_" & DateStamp & ".csv"
             
            Dim xWB As Workbook
            For Each xWB In Application.Workbooks
                If xWB.Name <> ThisWorkbook.Name Then xWB.Close True
            Next xWB
            
            Application.ScreenUpdating = True
        
NextFolder:
    Next vItem

End Sub