• Web and Email Hosting Services
  • DotNetNuke portal hosting
  • WordPress Hosting
  • Computer hardware and software consulting services
  • Computer Networking and Internet Connectivity (Wired and Wireless)
  • Computer Security Services
    • Virus Detection and Removal
    • Spyware Detection and Removal
  • Data Recovery Services
    • Accidental Hard Drive Reformat / Restore
    • Outlook OST to PST Conversion
  • Software Development Services
    • MS Access
    • Excel
    • Word
    • VB.NET
    • SQL Server
  • Google Apps Setup
Oct
28

VBA: Copy, Move and Delete files and folders

By

This post is from Ron de Bruin’s blog (http://www.rondebruin.nl/folder.htm).

On this page you can find example code to copy, move and delete files and folders.

There are three sections on this page :

1) Copy and Move files and folders

2) Delete files and folders

3) Special Folders

4) VBS script to clear the Temp folder

Copy and Move files and folders

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

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

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

Filesystemobject example code’s

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

Delete files and folders

Important !

Read this page from Chip Pearson first

http://www.cpearson.com/excel/Recycle.htm

From Chip’s site :

You need to remember, though, that Kill permanently deletes the file.

There is no way to “undo” the delete. The file is not sent to the Windows Recycle Bin

( Same for the macro’s that use the filesystemobject )

Sub DeleteExample1()
'You can use this to delete all the files in the folder Test
    On Error Resume Next
    Kill "C:\Users\Ron\Test\*.*"
    On Error GoTo 0
End Sub

Sub DeleteExample2()
'You can use this to delete all xl? files in the folder Test
    On Error Resume Next
    Kill "C:\Users\Ron\Test\*.xl*"
    On Error GoTo 0
End Sub

Sub DeleteExample3()
'You can use this to delete one xls file in the folder Test
    On Error Resume Next
    Kill "C:\Users\Ron\Test\ron.xls"
    On Error GoTo 0
End Sub

Sub DeleteExample4()
'You can use this to delete the whole folder
'Note: RmDir delete only a empty folder
    On Error Resume Next
    Kill "C:\Users\Ron\Test\*.*"    ' delete all files in the folder
    RmDir "C:\Users\Ron\Test\" ' delete folder 
    On Error GoTo 0
End Sub

Sub Delete_Whole_Folder()
'Delete whole folder without removing the files first like in DeleteExample4
    Dim FSO As Object
    Dim MyPath As String

    Set FSO = CreateObject("scripting.filesystemobject")

    MyPath = "C:\Users\Ron\Test"  '<< Change

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

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

    FSO.deletefolder MyPath

End Sub


Sub Clear_All_Files_And_SubFolders_In_Folder()
'Delete all files and subfolders
'Be sure that no file is open in the folder
    Dim FSO As Object
    Dim MyPath As String

    Set FSO = CreateObject("scripting.filesystemobject")

    MyPath = "C:\Users\Ron\Test"  '<< Change

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

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

    On Error Resume Next
    'Delete files
    FSO.deletefile MyPath & "\*.*", True
    'Delete subfolders
    FSO.deletefolder MyPath & "\*.*", True
    On Error GoTo 0

End Sub

SpecialFolders

How do I get the path of a special folder and open the folder ?

Sub GetSpecialFolder()
'Special folders are : AllUsersDesktop, AllUsersStartMenu
'AllUsersPrograms, AllUsersStartup, Desktop, Favorites
'Fonts, MyDocuments, NetHood, PrintHood, Programs, Recent
'SendTo, StartMenu, Startup, Templates

'Get Favorites folder and open it
    Dim WshShell As Object
    Dim SpecialPath As String

    Set WshShell = CreateObject("WScript.Shell")
    SpecialPath = WshShell.SpecialFolders("Favorites")
    MsgBox SpecialPath
    'Open folder in Explorer
    Shell "explorer.exe " & SpecialPath, vbNormalFocus
End Sub


Sub VBA_GetSpecialFolder_functions()
'Here are a few VBA path functions
    MsgBox Application.Path
    MsgBox Application.DefaultFilePath
    MsgBox Application.TemplatesPath
    MsgBox Application.StartupPath
    MsgBox Application.UserLibraryPath
    MsgBox Application.LibraryPath
End Sub

Temp folder

Without code you can do this to open the temp folder

Start>Run

Enter %temp%

OK

Or use one of the two code examples

Sub GetTempFolder_1()
    MsgBox Environ("Temp")
    'Open folder in Explorer
    Shell "explorer.exe " & Environ("Temp"), vbNormalFocus
End Sub

Sub GetTempFolder_2()
    Dim FSO As Object, TmpFolder As Object
    Set FSO = CreateObject("scripting.filesystemobject")
    Set TmpFolder = FSO.GetSpecialFolder(2)
    MsgBox TmpFolder
    'Open folder in Explorer
    Shell "explorer.exe " & TmpFolder, vbNormalFocus
End Sub

0 = The Windows folder contains files installed by the Windows operating sys

1 = The System folder contains libraries, fonts, and device drivers

Categories : VBA

Leave a Reply

You must be logged in to post a comment.