CODEWITHSUNDEEP
excelvbafor-loop
Puno
Puno

Reputation: 61

How to Loop a string array of folder names to duplicate a file and rename it?

The following code that will duplicate a file and rename it.

I now have the need to scale it to multiple folders which I stored in an array. The code correctly duplicates the first file.

It gives an error when when it tries to open the second directory (I will be scaling up to 30+ directories). It seems the loop starts in middle.

I use example variable names & paths for security reasons.

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

Upvotes: 0

Views: 199

Answers (1)

BrunoQuintero
BrunoQuintero

Reputation: 151

Please try the following, I simplified a little your code

Your variable "LatestDate" was declared at the beggining of the sub and never reseted, so at the moment loop reached the second array position, the previous "LastDate" persisted, and if on second folder there was no file with higher filedatetime then persisted the same saved before, making appear as if the first loop was skipped.

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

Upvotes: 1

Related Questions