Excel VBA: List Files of Folder/Subfolder & Rename Files with new filename

harky

Active Member
Joined
Apr 8, 2010
Messages
405
Office Version
  1. 2021
  2. 2019
Platform
  1. Windows
Hi need some help, i try to search around the forum but seen not able to find one i want.

Step 1 (list filename of Folder & SubFolder), there will be a POP-UP and ask user to select the path
Step 2 (rename filename base on col C) & Status update on Col D

Isit gd ideal to display ext?


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]Path[/TD]
[TD]Original Filename[/TD]
[TD]New Filename[/TD]
[TD]Status[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Renamed / Error[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Step 2

rename filename base on col C, also base on the path at col A

So this will not rename the folder or sub-folder?
 
Upvote 0
Last edited:
Upvote 0
I want to do it in excel as I had many file to rename.. And it much easy.
 
Last edited:
Upvote 0
Step 2 (something like this but not really the one i want.

Code:
Public Sub renameWorkbook()
    For r = 2 To Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
        filePath = Range("A" & r)
        oldFileNm = Range("B" & r)
        newFileNm = Range("C" & r)
        Name filePath & oldFileNm As filePath & newFileNm
    Next r
End Sub
 
Upvote 0
Hi Sorry..

I make a change


Hi need some help, i try to search around the forum but seen not able to find one i want.

Step 1: List filename with ext on Folder & SubFolder with path


Step 2: Rename path+filename base on col B) & Status update on Col C

Isit gd ideal to display ext?


Step 2
[TABLE="class: cms_table_grid, width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]Original
Path + Filename[/TD]
[TD]NEW
Path + Filename[/TD]
[TD]Status[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C:\Users\AAA\Downloads\ABC.xlsm[/TD]
[TD]C:\Users\AAA\Downloads\123.xlsm[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Upvote 0
I found a code that will list the part 1.


but it has error..
@ Set Folder = OBJ.GetFolder(strPath)

part 1 Code

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]Original FileName[/TD]
[TD]Path[/TD]
[/TR]
[TR]
[TD]ABC.xlsm[/TD]
[TD]C:\Users\AAA\Downloads\ABC.xlsm[/TD]
[/TR]
</tbody>[/TABLE]


Code:
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




Sub GetFolder()


Range("A:B").ClearContents
Range("A1").Value = "Original FilName"
Range("B1").Value = "Path"
Range("A1").Select


Dim strPath As String
'strPath = "C:\"
strPath = UserGetFolder


Dim OBJ As Object, Folder As Object, File As Object




Set OBJ = CreateObject("Scripting.FileSystemObject")
[COLOR=#ff0000]Set Folder = OBJ.GetFolder(strPath)[/COLOR]


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


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Sub ListFiles(ByRef Folder As Object)


For Each File In Folder.Files
        ActiveCell.Offset(1, 0).Select
        ActiveCell = File.Name
        ActiveCell.Offset(0, 1) = File.Path
Next File


End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


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
 
Last edited:
Upvote 0
I reply my own question. Manage to get it fix :)

Will be great if someone can tell me how to get delete or hid Thumbs.db

Code:
Sub ListFilesFromAllFolder()


Range("A:B").ClearContents
Range("A1").Value = "Original File Name"
Range("B1").Value = "Path"
Range("A1").Select


Dim strPath As String
'strPath = "C:\"
strPath = UserGetFolder


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


Columns("A:L").AutoFit
Range("A1").Select


End Sub


Private Sub ListFiles(ByRef Folder As Object)


For Each File In Folder.Files
        ActiveCell.Offset(1, 0).Select
        ActiveCell = File.Name
        ActiveCell.Offset(0, 1) = File.Path
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


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


I found a code that will list the part 1.


but it has error..
@ Set Folder = OBJ.GetFolder(strPath)

part 1 Code

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]Original FileName[/TD]
[TD]Path[/TD]
[/TR]
[TR]
[TD]ABC.xlsm[/TD]
[TD]C:\Users\AAA\Downloads\ABC.xlsm[/TD]
[/TR]
</tbody>[/TABLE]


Code:
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




Sub GetFolder()


Range("A:B").ClearContents
Range("A1").Value = "Original FilName"
Range("B1").Value = "Path"
Range("A1").Select


Dim strPath As String
'strPath = "C:\"
strPath = UserGetFolder


Dim OBJ As Object, Folder As Object, File As Object




Set OBJ = CreateObject("Scripting.FileSystemObject")
[COLOR=#ff0000]Set Folder = OBJ.GetFolder(strPath)[/COLOR]


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


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Sub ListFiles(ByRef Folder As Object)


For Each File In Folder.Files
        ActiveCell.Offset(1, 0).Select
        ActiveCell = File.Name
        ActiveCell.Offset(0, 1) = File.Path
Next File


End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


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
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,213
Members
452,618
Latest member
Tam84

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top