Ron de Bruin
Excel Automation

Copy and Move files and folders

Important message to visitors of this page

Ron de Bruin decided to remove all Windows Excel content from his website for personal reasons. If you want to know why, head over to rondebruin.nl.

Luckily, Ron was kind enough to allow me to publish all of his Excel content here.

Most of these pages are slightly outdated and may contain links that don 't work. Please inform me if you find such an error and I'll try to fix it.

Kind regards

Jan Karel Pieterse

Below are a few examples to copy and move files and folders.

Copy or Move one file

For one file you can use the VBA Name and FileCopy function and for entire folders or a lot of files use the other macro example's on this page.

Sub Copy_One_File()
    FileCopy "C:\Users\Ron\SourceFolder\Test.xls", "C:\Users\Ron\DestFolder\Test.xls"
End Sub

Sub Move_Rename_One_File()
'You can change the path and file name
    Name "C:\Users\Ron\SourceFolder\Test.xls" As "C:\Users\Ron\DestFolder\TestNew.xls"
End Sub

Copy or move more files or complete folders

Note: Read the commented code lines in the code

Sub Copy_Folder()
'This example copy all files and subfolders from FromPath to ToPath.
'Note: If ToPath already exist it will overwrite existing files in this folder
'if ToPath not exist it will be made for you.
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String

    FromPath = "C:\Users\Ron\Data"  '<< Change
    ToPath = "C:\Users\Ron\Test"    '<< Change

    'If you want to create a backup of your folder every time you run this macro
    'you can create a unique folder with a Date/Time stamp.
    'ToPath = "C:\Users\Ron\" & Format(Now, "yyyy-mm-dd h-mm-ss")

    If Right(FromPath, 1) = "\" Then
        FromPath = Left(FromPath, Len(FromPath) - 1)
    End If

    If Right(ToPath, 1) = "\" Then
        ToPath = Left(ToPath, Len(ToPath) - 1)
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    FSO.CopyFolder Source:=FromPath, Destination:=ToPath
    MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath

End Sub


Sub Move_Rename_Folder()
'This example move the folder from FromPath to ToPath.
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String

    FromPath = "C:\Users\Ron\Data"  '<< Change
    ToPath = "C:\Users\Ron\Test"    '<< Change
    'Note: It is not possible to use a folder that exist in ToPath

    If Right(FromPath, 1) = "\" Then
        FromPath = Left(FromPath, Len(FromPath) - 1)
    End If

    If Right(ToPath, 1) = "\" Then
        ToPath = Left(ToPath, Len(ToPath) - 1)
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = True Then
        MsgBox ToPath & " exist, not possible to move to a existing folder"
        Exit Sub
    End If

    FSO.MoveFolder Source:=FromPath, Destination:=ToPath
    MsgBox "The folder is moved from " & FromPath & " to " & ToPath

End Sub


Sub Copy_Files_Dates()
'This example copy all files between certain dates from FromPath to ToPath.
'You can also use this to copy the files from the last ? days
'If Fdate >= Date - 30 Then
'Note: If the files in ToPath already exist it will overwrite
'existing files in this folder
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim Fdate As Date
    Dim FileInFromFolder As Object

    FromPath = "C:\Users\Ron\Data"  '<< Change
    ToPath = "C:\Users\Ron\Test"    '<< Change

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    If Right(ToPath, 1) <> "\" Then
        ToPath = ToPath & "\"
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If

    For Each FileInFromFolder In FSO.getfolder(FromPath).Files
        Fdate = Int(FileInFromFolder.DateLastModified)
        'Copy files from 1-Oct-2006 to 1-Nov-2006
        If Fdate >= DateSerial(2006, 10, 1) And Fdate <= DateSerial(2006, 11, 1) Then
            FileInFromFolder.Copy ToPath
        End If
    Next FileInFromFolder

    MsgBox "You can find the files from " & FromPath & " in " & ToPath

End Sub


Sub Copy_Certain_Files_In_Folder()
'This example copy all Excel files from FromPath to ToPath.
'Note: If the files in ToPath already exist it will overwrite
'existing files in this folder
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String

    FromPath = "C:\Users\Ron\Data"  '<< Change
    ToPath = "C:\Users\Ron\Test"    '<< Change

    FileExt = "*.xl*"  '<< Change
    'You can use *.* for all files or *.doc for Word files

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If

    FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
    MsgBox "You can find the files from " & FromPath & " in " & ToPath

End Sub


Sub Move_Certain_Files_To_New_Folder()
'This example move all Excel files from FromPath to ToPath.
'Note: It will create the folder ToPath for you with a date-time stamp
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String
    Dim FNames As String

    FromPath = "C:\Users\Ron\Data"  '<< Change
    ToPath = "C:\Users\Ron\" & Format(Now, "yyyy-mm-dd h-mm-ss") _
           & " Excel Files" & "\"    '<< Change only the destination folder

    FileExt = "*.xl*"   '<< Change
    'You can use *.* for all files or *.doc for word files

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    FNames = Dir(FromPath & FileExt)
    If Len(FNames) = 0 Then
        MsgBox "No files in " & FromPath
        Exit Sub
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    FSO.CreateFolder (ToPath)

    FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath
    MsgBox "You can find the files from " & FromPath & " in " & ToPath

End Sub

Copyright © 2022 Ron de Bruin

Site designed by Spider Web Woman Designs