Copy Files to folder

[Robie]

Hi

I need to create a folder (e.g. "ABCD_12.3") and then copy all the files starting with "ABCD_12_3*.*" to this folder. The folder is off "C:\Spreadsheet\".

Any idea how to do this in VBA please?

Thanks.
Robie

[Rudi]

Do you need the code to create the folder or will one already exist that the code can simply copy the files to?

[Robie]

Do you need the code to create the folder or will one already exist that the code can simply copy the files to?

Thanks for quick response Rudi.

The folder has to created but it may exist already.

[Rudi]

Try this.
Place in a standard Excel VBA module.

Code: Select all

Sub CopyToFolder()
Dim FSO As Object
Dim dFolder As String
Dim sFolder As String
Dim sFile As String

    sFolder = "C:\Spreadsheet\"    'Specify Your Source Folder
    dFolder = "C:\ABCD_12.3\"    'Specify Destination Folder
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(dFolder) Then FSO.CreateFolder (dFolder)

    If Not FSO.FolderExists(sFolder) Then
        MsgBox "Source Folder Not Found", vbInformation, "Source Not Found!"
        Exit Sub
    Else
        sFile = Dir(sFolder)
        Do While Len(sFile) > 0
            If Left(sFile, 9) = "ABCD_12_3" Then
                FSO.CopyFile (sFolder & sFile), dFolder
            End If
            sFile = Dir
        Loop
        MsgBox "Successfully Copied All Files to Destination.", vbInformation, "Done!"
    End If
End Sub

[Robie]

Try this.
Place in a standard Excel VBA module.

Code: Select all

Sub CopyToFolder()
Dim FSO As Object
Dim dFolder As String
Dim sFolder As String
Dim sFile As String

    sFolder = "C:\Spreadsheet\"    'Specify Your Source Folder
    dFolder = "C:\ABCD_12.3\"    'Specify Destination Folder
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(dFolder) Then FSO.CreateFolder (dFolder)

    If Not FSO.FolderExists(sFolder) Then
        MsgBox "Source Folder Not Found", vbInformation, "Source Not Found!"
        Exit Sub
    Else
        sFile = Dir(sFolder)
        Do While Len(sFile) > 0
            If Left(sFile, 9) = "ABCD_12_3" Then
                FSO.CopyFile (sFolder & sFile), dFolder
            End If
            sFile = Dir
        Loop
        MsgBox "Successfully Copied All Files to Destination.", vbInformation, "Done!"
    End If
End Sub

Thank you so much Rudi.

That works beautifully.