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

[harky]

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?

A	B	C	D
Path	Original Filename	New Filename	Status
			Renamed / Error

<tbody>
</tbody>

 

[harky]

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?

 

[RockandGrohl]

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?

Not entirely what you're looking for, but this can be done in Command Prompt & Excel very easily and really really quickly:

https://benholland.me/tutorials/2011/11/11/rename-multiple-files-using-excel-in-windows.html

 

[harky]

I want to do it in excel as I had many file to rename.. And it much easy.

 

[harky]

Step 2 (something like this but not really the one i want.

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

 

[harky]

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

A	B	C	D
Original Path + Filename	NEW Path + Filename	Status
C:\Users\AAA\Downloads\ABC.xlsm	C:\Users\AAA\Downloads\123.xlsm

<tbody>
</tbody>

 

[harky]

I found a code that will list the part 1.


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

part 1 Code

A	B
Original FileName	Path
ABC.xlsm	C:\Users\AAA\Downloads\ABC.xlsm

<tbody>
</tbody>

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

 

[harky]

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

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

A	B
Original FileName	Path
ABC.xlsm	C:\Users\AAA\Downloads\ABC.xlsm

<tbody>
</tbody>

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