This request came from a subscriber who was looking for a macro to rename files in a given folder, and make a copy of the renamed file within the same folder. Once the files in the top level folder were processed, then cycle through each subfolder and do the same. The following macro will accomplish this task, and has been setup to read file types of “.pdf” format.
If you are looking for content that does not exist on my blog, please submit a request through the “Contact” page.
Excel Version: 2013
OS: Windows 10
Excel VBA Copy and Rename Files in Folder and Subfolder – Setup
For this macro, there are three folders:
Top-level folder:
Sub-folder “TestFilesSub”:
Sub-folder “TestFilesSubTwo”:
Add the macro code below:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 |
Option Explicit Sub GetFolder() Range("A:L").ClearContents Range("A1").Value = "Name" Range("B1").Value = "Path" Range("C1").Value = "Rename" Range("A1").Select Dim strPath As String strPath = "C:\BuffaloBI - Post Content\TestFiles\" Dim OBJ As Object Dim Folder As Object Dim File As Object Set OBJ = CreateObject("Scripting.FileSystemObject") Set Folder = OBJ.GetFolder(strPath) Call ListFiles(Folder) Dim SubFolder As Object For Each SubFolder In Folder.SubFolders Call ListFiles(SubFolder) Call GetSubFolders(SubFolder) Next SubFolder Range("A1").Select End Sub Private Sub ListFiles(ByRef Folder As Object) Dim File As Object For Each File In Folder.Files ' This If Statement will filter down the file type to make copies of If Right(File, 4) = ".pdf" Then ActiveCell.Offset(1, 0).Select ActiveCell = File.Name ActiveCell.Offset(0, 1) = File.Path ActiveCell.Offset(0, 2) = "Copy of " & File.Name ' Next, I am simply creating a default text to Rename the file, then ' making a copy of the file in the same folder the original file FileCopy File, Replace(File.Path, File.Name, "") & "Copy of " & File.Name Else End If Next File End Sub Private Sub GetSubFolders(ByRef SubFolder As Object) Dim FolderItem As Object For Each FolderItem In SubFolder.SubFolders Call ListFiles(FolderItem) Call GetSubFolders(FolderItem) Next FolderItem End Sub |
Run the macro, and you will now see a copy of each file, renamed with a pre-fix file name of “Copy of – [Original File Name]”, in the top-level folder and each subfolder beneath:
Top-level folder:
Sub-folder “TestFilesSub”:
Sub-folder “TestFilesSubTwo”:
Please modify the macro to suit your needs!
Additional Content
Check out more examples by visiting my Home Page
Here you will find topics covering Qlikview SQL Server Excel VBA