Files naming macro

momo6

New Member
Joined
May 24, 2020
Messages
37
Office Version
  1. 365
Platform
  1. Windows
Hi guys, I have the following macro script, I am facing a situation with a folder that contains many subfolders and inside them there is a lot of files, is there by any chance a possibility to modify this macro so instead of displaying the files inside it only, it displays the files inside it + the files inside the subfolders? Thank you very much.


Sub FetchNames()

Dim myPath As String
Dim myFile As String
myPath = Sheet1.[addr]
myFile = Dir(myPath & "*.*")

r = 5
Do While myFile <> ""
Cells(r, 1).Value = myFile
r = r + 1
myFile = Dir
Loop

End Sub
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
.
I know this is not your macro ... but it does work ...

VBA Code:
Option Explicit

'the first row with data
Const ROW_FIRST As Integer = 5

'This is an event handler. It exectues when the user
'presses the run button
Private Sub btnGet_Click()
On Error Resume Next

'determines if the user selects a directory
'from the folder dialog
Dim intResult As Integer

'the path selected by the user from the
'folder dialog
Dim strPath As String

'Filesystem object
Dim objFSO As Object

'the current number of rows
Dim intCountRows As Integer
Application.FileDialog(msoFileDialogFolderPicker).Title = _
"Select a Path"

'the dialog is displayed to the user
intResult = Application.FileDialog( _
msoFileDialogFolderPicker).Show

'checks if user has cancled the dialog
If intResult <> 0 Then
    strPath = Application.FileDialog(msoFileDialogFolderPicker _
    ).SelectedItems(1)
    
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
       
    'loops through each file in the directory and prints their
    'names and path
    intCountRows = GetAllFiles(strPath, ROW_FIRST, objFSO)
    
    'loops through all the files and folder in the input path
    Call GetAllFolders(strPath, objFSO, intCountRows)
    
End If

End Sub
'''
'This function prints the name and path of all the files
'in the directory strPath
'strPath: The path to get the list of files from
'intRow: The current row to start printing the file names
'in
'objFSO: A Scripting.FileSystem object.

Private Function GetAllFiles(ByVal strPath As String, _
ByVal intRow As Integer, ByRef objFSO As Object) As Integer

On Error Resume Next

Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

i = intRow - ROW_FIRST + 1

Set objFolder = objFSO.GetFolder(strPath)

For Each objFile In objFolder.Files
        'print file name
        Cells(i + ROW_FIRST - 1, 1) = objFile.Name
        
        'print file path
        Cells(i + ROW_FIRST - 1, 2) = objFile.Path
        i = i + 1
Next objFile

GetAllFiles = i + ROW_FIRST - 1

End Function

'''
'This function loops through all the folders in the
'input path. It makes a call to the GetAllFiles
'function. It also makes a  recursive call to itself
'strFolder: The folder to loop through
'objFSO: A Scripting.FileSystem object
'intRow: The current row to print the file data on
Private Sub GetAllFolders(ByVal strFolder As String, _
    ByRef objFSO As Object, ByRef intRow As Integer)
    On Error Resume Next

Dim objFolder As Object
Dim objSubFolder As Object

'Get the folder object
Set objFolder = objFSO.GetFolder(strFolder)

'loops through each file in the directory and
'prints their names and path
For Each objSubFolder In objFolder.subfolders
    
    intRow = GetAllFiles(objSubFolder.Path, _
        intRow, objFSO)
    
    'recursive call to to itsself
    Call GetAllFolders(objSubFolder.Path, _
        objFSO, intRow)

Next objSubFolder

End Sub
 
Upvote 0
1590369655230.png


The above is the sheet Main
 
Upvote 0
Another one

VBA Code:
Sub ListAll()
    
    Application.ScreenUpdating = False
    
    ListFiles Sheet1.[addr], "*.*", 5
    'ListFiles "C:\Test", "*.*", 5
    
    Columns("A:B").AutoFit
    
    Application.ScreenUpdating = True
    
End Sub


Sub ListFiles(ByVal strPath As String, ByVal strFilePattern As String, ByRef r As Long)
                 
    Dim fsoSubfolder As Object, strFile As String
   
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
   
    strFile = Dir(strPath & strFilePattern)
   
    Do While Len(strFile)
        ActiveSheet.Cells(r, 1).Value = strPath
        ActiveSheet.Cells(r, 2).Value = strFile
        r = r + 1
        strFile = Dir
   Loop
  
    'Search sub folders
    For Each fsoSubfolder In CreateObject("Scripting.FileSystemObject").GetFolder(strPath).SubFolders
        ListFiles fsoSubfolder.Path, strFilePattern, r
    Next fsoSubfolder
   
End Sub
 
Last edited:
Upvote 0
.
I know this is not your macro ... but it does work ...

VBA Code:
Option Explicit

'the first row with data
Const ROW_FIRST As Integer = 5

'This is an event handler. It exectues when the user
'presses the run button
Private Sub btnGet_Click()
On Error Resume Next

'determines if the user selects a directory
'from the folder dialog
Dim intResult As Integer

'the path selected by the user from the
'folder dialog
Dim strPath As String

'Filesystem object
Dim objFSO As Object

'the current number of rows
Dim intCountRows As Integer
Application.FileDialog(msoFileDialogFolderPicker).Title = _
"Select a Path"

'the dialog is displayed to the user
intResult = Application.FileDialog( _
msoFileDialogFolderPicker).Show

'checks if user has cancled the dialog
If intResult <> 0 Then
    strPath = Application.FileDialog(msoFileDialogFolderPicker _
    ).SelectedItems(1)
   
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
      
    'loops through each file in the directory and prints their
    'names and path
    intCountRows = GetAllFiles(strPath, ROW_FIRST, objFSO)
   
    'loops through all the files and folder in the input path
    Call GetAllFolders(strPath, objFSO, intCountRows)
   
End If

End Sub
'''
'This function prints the name and path of all the files
'in the directory strPath
'strPath: The path to get the list of files from
'intRow: The current row to start printing the file names
'in
'objFSO: A Scripting.FileSystem object.

Private Function GetAllFiles(ByVal strPath As String, _
ByVal intRow As Integer, ByRef objFSO As Object) As Integer

On Error Resume Next

Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

i = intRow - ROW_FIRST + 1

Set objFolder = objFSO.GetFolder(strPath)

For Each objFile In objFolder.Files
        'print file name
        Cells(i + ROW_FIRST - 1, 1) = objFile.Name
       
        'print file path
        Cells(i + ROW_FIRST - 1, 2) = objFile.Path
        i = i + 1
Next objFile

GetAllFiles = i + ROW_FIRST - 1

End Function

'''
'This function loops through all the folders in the
'input path. It makes a call to the GetAllFiles
'function. It also makes a  recursive call to itself
'strFolder: The folder to loop through
'objFSO: A Scripting.FileSystem object
'intRow: The current row to print the file data on
Private Sub GetAllFolders(ByVal strFolder As String, _
    ByRef objFSO As Object, ByRef intRow As Integer)
    On Error Resume Next

Dim objFolder As Object
Dim objSubFolder As Object

'Get the folder object
Set objFolder = objFSO.GetFolder(strFolder)

'loops through each file in the directory and
'prints their names and path
For Each objSubFolder In objFolder.subfolders
   
    intRow = GetAllFiles(objSubFolder.Path, _
        intRow, objFSO)
   
    'recursive call to to itsself
    Call GetAllFolders(objSubFolder.Path, _
        objFSO, intRow)

Next objSubFolder

End Sub

Hi dude, I am totally new to this so could you please tell me, do I just copy-paste this code to the VBA? Do I have to modify something in it because I am reviewing an error message concerning debugging. Thanks
 
Upvote 0
Paste the macro to a Regular Module in the VBA Window Editor. If you don't already have a Regular Module, create one then paste the code in the right sided window.

Then change the name of one of your sheets to MAIN. Next, create a command button at the top of that sheet (like you see in the picture) and name the button
btnGet . When you click the button, it should work.
 
Upvote 0
Paste the macro to a Regular Module in the VBA Window Editor. If you don't already have a Regular Module, create one then paste the code in the right sided window.

Then change the name of one of your sheets to MAIN. Next, create a command button at the top of that sheet (like you see in the picture) and name the button
btnGet . When you click the button, it should work.
Thanks it is working, another thing please. So basically I want to add a stem to the these resulted files and rename them all at once. Is that possible with the VBA code you suggested, as in the screenshot below?, thanks
1590372017044.png
 
Upvote 0
You'll need another macro for renaming files.

What is the renaming format you anticipate ?
 
Upvote 0
You'll need another macro for renaming files.

What is the renaming format you anticipate ?
I want a macro that will allow me to add a stem/name convention to the beginning of the name, I have to put this stem manually depending on the name of each project, and I want it to be populated across all files in the project folder. Is that possibe? If yes, could you kindly help me by suggesting a solution? Thanks a lot bro
 
Upvote 0

Forum statistics

Threads
1,215,796
Messages
6,126,959
Members
449,350
Latest member
Sylvine

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