VBA Copy File, notify if file not available

[TaskMaster]

Hi All,

I have the following which will copy a list of files and paste them into my monthly folder as needed. Is there a way to notify me if any of these files aren't in the Folder location and can't be copied. Also is it possible to add if this file already exists in the new location do not copy?

Sub Copy_Files()

Dim Folder As String
Dim Dest As String
Dim fso As Object
Dim LastMonth As Date

Set fso = VBA.CreateObject("Scripting.FileSystemObject")
LastMonth = DateSerial(Year(Date), (Month(Date) - 1), Day(Date))
Folder = "\\users\TM\Desktop\Test\"
Dest = "\\users\TM\Desktop\Test\" & Format(LastMonth, "mm. ") & Format(LastMonth, "mmmm") & "\Data\Reports"

Call fso.CopyFile(Folder & "330016*", Dest)

Call fso.CopyFile(Folder & "330008*", Dest)

Call fso.CopyFile(Folder & "330009*", Dest)

Call fso.CopyFile(Folder & "330010*", Dest)

Call fso.CopyFile(Folder & "330011*", Dest)

Call fso.CopyFile(Folder & "330013*", Dest)

Call fso.CopyFile(Folder & "330014*", Dest)

Call fso.CopyFile(Folder & "334008*", Dest)

Call fso.CopyFile(Folder & "334009*", Dest)

Call fso.CopyFile(Folder & "334010*", Dest)

Call fso.CopyFile(Folder & "334011*", Dest)

Call fso.CopyFile(Folder & "358026*", Dest)

Call fso.CopyFile(Folder & "358027*", Dest)


End Sub

 

[John_w]

Try this macro:

Public Sub Copy_Files2()

    Dim Folder As String
    Dim Dest As String
    Dim LastMonth As Date
    
    LastMonth = DateSerial(Year(Date), (Month(Date) - 1), Day(Date))
    Folder = "\\users\TM\Desktop\Test\"
    Dest = "\\users\TM\Desktop\Test\" & Format(LastMonth, "mm. ") & Format(LastMonth, "mmmm") & "\Data\Reports"
    
    Check_and_Copy_Files Folder & "330016*.*", Dest
    
    Check_and_Copy_Files Folder & "330008*.*", Dest
    
    Check_and_Copy_Files Folder & "330009*.*", Dest
    
    Check_and_Copy_Files Folder & "330010*.*", Dest
    
    Check_and_Copy_Files Folder & "330011*", Dest
    
    Check_and_Copy_Files Folder & "330013*", Dest
    
    Check_and_Copy_Files Folder & "330014*", Dest
    
    Check_and_Copy_Files Folder & "334008*", Dest
    
    Check_and_Copy_Files Folder & "334009*", Dest
    
    Check_and_Copy_Files Folder & "334010*", Dest
    
    Check_and_Copy_Files Folder & "334011*", Dest
    
    Check_and_Copy_Files Folder & "358026*", Dest
    
    Check_and_Copy_Files Folder & "358027*", Dest

End Sub


Private Sub Check_and_Copy_Files(sourceFolderMatchFiles As String, destFolder As String)

    Static FSO As Object
    Dim FSfile As Object
    Dim sourceFolder As String, matchFiles As String
    Dim p As Long, n As Long
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
   
    If Right(destFolder, 1) <> "\" Then destFolder = destFolder & "\"
    p = InStrRev(sourceFolderMatchFiles, "\")
    sourceFolder = Left(sourceFolderMatchFiles, p)
    matchFiles = Mid(sourceFolderMatchFiles, p + 1)
    
    n = 0
    For Each FSfile In FSO.GetFolder(sourceFolder).Files
        If LCase(FSfile.Name) Like LCase(matchFiles) Then n = n + 1
    Next
    
    If n = 0 Then
        MsgBox "There are no files in " & sourceFolder & " matching " & matchFiles & ", therefore no files copied to " & destFolder, vbInformation, "No files copied"
    Else
        For Each FSfile In FSO.GetFolder(sourceFolder).Files
            If LCase(FSfile.Name) Like LCase(matchFiles) Then
                If FSO.FileExists(destFolder & FSfile.Name) = False Then
                    FSfile.Copy destFolder
                End If
            End If
        Next
    End If
    
End Sub

 

[TaskMaster]

Hi John, this works perfectly. Thank you very much!

 

[TaskMaster]

Hi John, looping back around to this query. As it stands the process works perfectly. Im wondering if it is possible to rename the files when moving from .txt to .csv

 

[John_w]

rename the files when moving from .txt to .csv

Replace the Check_and_Copy_Files function with:

Private Sub Check_and_Copy_Files(sourceFolderMatchFiles As String, destFolder As String)

    Static FSO As Object
    Dim FSfile As Object
    Dim sourceFolder As String, matchFiles As String
    Dim p As Long, n As Long
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    
    'if any of these files aren't in the Folder location and can't be copied. Also is it possible to add if this file already exists in
    'the new location do not copy?
    
    If Right(destFolder, 1) <> "\" Then destFolder = destFolder & "\"
    p = InStrRev(sourceFolderMatchFiles, "\")
    sourceFolder = Left(sourceFolderMatchFiles, p)
    matchFiles = Mid(sourceFolderMatchFiles, p + 1)
    
    n = 0
    For Each FSfile In FSO.GetFolder(sourceFolder).Files
        Debug.Print FSfile
        If LCase(FSfile.Name) Like LCase(matchFiles) Then n = n + 1
    Next
    
    If n = 0 Then
        MsgBox "There are no files in " & sourceFolder & " matching " & matchFiles & ", therefore no files copied to " & destFolder, vbInformation, "No files copied"
    Else
        For Each FSfile In FSO.GetFolder(sourceFolder).Files
            If LCase(FSfile.Name) Like LCase(matchFiles) Then
                If FSO.FileExists(destFolder & FSfile.Name) = False Then
                    If LCase(FSfile.Name) Like "*.txt" Then
                        'Rename .txt file as .csv
                        FSO.CopyFile FSfile.Path, destFolder & Replace(FSfile.Name, ".txt", ".csv")
                    Else
                        FSfile.Copy destFolder
                    End If
                End If
            End If
        Next
    End If
    
End Sub

Note the change only affects .txt files (i.e. only .txt files are renamed as .csv), otherwise all previous functionality is retained.