Excel VBA Copy and Rename Files

I received a question on post Excel VBA Rename Files and thought a separate post was warranted to cover the answer.  In the following example, I will setup an Excel file to do the following:

  • Allow user to pick a folder and list out the file content (file path and name)
  • Allow user to pick a destination folder for location to move the files
  • Allow user to rename each file prior to moving to destination folder

Setup:  Excel VBA Copy and Rename Files

Example file containing content at the bottom of this post

In a new Excel file, add the following:

  • Cell A3 Text:  Current File Path      Column Width:  45
  • Cell B3 Text:  Current File Name    Column Width:  25
  • Cell C3 Text:  New File Path          Column Width:  45
  • Cell D3 Text:  New File Name       Column Width:  25

Next, add three Command Buttons (Active X controls):

Excel VBA Copy and Rename Files

Position the buttons as follows:

Excel VBA Copy and Rename Files

In the “Properties” box for each button, set the following:

  • (Name):  cmdPickFolder             Caption:  Pick folder to list files you want to copy
  • (Name):  cmdPickDestination     Caption:  Pick folder you want to copy files to
  • (Name):  cmdCopy                     Caption:  Copy Files!

Position the buttons according to picture above.

Next, Insert a new module and add the following code:

Next, add the following code to each button control:

And that should do it!  This workbook allows you to pick a folder and list file content, pick destination folder to move the files, then allows you to rename each file prior to the move.

 

Example File:

Excel VBA Copy and Rename Files

 

Additional Content

Check out more examples by visiting my Home Page

Here you will find topics covering  Qlikview  SQL Server  Excel VBA

 

 

12 thoughts on “Excel VBA Copy and Rename Files”

  1. instead of copy the files to the same folder is there a way we specify a new folder name and excel will create that folder and copy that file into that.

    Reply
    • Sameer, using the existing sample file, replace the following block of code with the following. This will prompt you to enter a new folder name, then you can browse/select a parent folder. You still need to enter the new file names and click the Copy Files button. It will then copy the files to the new folder:


      Sub DestFolderSelect()

      Dim strPath As String
      Dim strFolder As String
      Dim LastRow As Long
      Dim DestRng As Range

      strFolder = InputBox("Enter New Folder Name", "New Folder")

      Range("C4").Select
      strPath = UserGetFolder & "\"

      MkDir strPath & strFolder
      strPath = strPath & strFolder & "\"

      LastRow = Range("B" & Rows.Count).End(xlUp).Row
      Set DestRng = Range("C4:C" & LastRow)

      If strPath = "\" Then
      MsgBox "Please click button again and pick destination folder", vbCritical
      ElseIf LastRow = 4 Then
      Range("C4").Value = strPath
      Else
      Range("C4").Value = strPath
      ActiveCell.Copy
      DestRng.Select
      Selection.PasteSpecial xlPasteValues
      Application.CutCopyMode = False
      End If

      Range("C4").Select

      End Sub

      Reply
  2. is there any way instead of picking the folder ‘copy files to’ we can specify the new folder name and excel create that folder and move the new files.

    Reply
  3. Oops. What I mean is there a way to get it to either replace the original or delete the original so that only the renamed files remain?

    Reply
    • Here is the updated macro, which renames the original files.

      Option Explicit

      Sub CopyFiles()

      Dim strPath As String
      Dim F As String
      strPath = UserGetFolder & "\"
      F = Dir(strPath)

      Do While Len(F) > 0

      'FileCopy strPath & F, strPath & Left(F, InStr(1, F, ".", vbBinaryCompare) - 1) & ".design.pdf"
      Name strPath & F As strPath & Left(F, InStr(1, F, ".", vbBinaryCompare) - 1) & ".design.pdf"
      F = Dir()
      Loop

      MsgBox "Process complete!", vbInformation

      End Sub

      Function UserGetFolder() As String
      Dim fldr As FileDialog
      Dim sItem As String
      Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
      With fldr
      .Title = "Select a Folder"
      .AllowMultiSelect = False
      .InitialFileName = Application.DefaultFilePath
      If .Show <> -1 Then GoTo NextCode
      sItem = .SelectedItems(1)
      End With
      NextCode:
      UserGetFolder = sItem
      Set fldr = Nothing
      End Function

      Reply
  4. It does what I wanted but I want it to replace the destination file. Now I am getting both the original and the renamed. Thanks!

    Reply
  5. Ok, so I have been playing with this for a while and still have questions. I want to do this and be able to select the folder I want to rename. However, I want them to stay in the same folder and not have the option to move the files. Finally I regularly rename large numbers of files and all I want it to do it rename the current file with a “.design” behind the file name.

    For example file “S301.pdf” would become “S301.design.pdf” without me having to enter the renaming all the time.

    Reply
    • Hi Nicole, if I’m understanding your request properly, the macro below should work:


      Option Explicit

      Sub CopyFiles()

      Dim strPath As String
      Dim F As String

      strPath = UserGetFolder & "\"
      F = Dir(strPath)

      Do While Len(F) > 0
      FileCopy strPath & F, strPath & Left(F, InStr(1, F, ".", vbBinaryCompare) - 1) & ".design.pdf"
      F = Dir()
      Loop

      MsgBox "Process complete!", vbInformation

      End Sub

      Function UserGetFolder() As String
      Dim fldr As FileDialog
      Dim sItem As String
      Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
      With fldr
      .Title = "Select a Folder"
      .AllowMultiSelect = False
      .InitialFileName = Application.DefaultFilePath
      If .Show <> -1 Then GoTo NextCode
      sItem = .SelectedItems(1)
      End With
      NextCode:
      UserGetFolder = sItem
      Set fldr = Nothing
      End Function

      Reply

Leave a Comment