(Solved) – Enhancing the macro

  • by

I want to improve my Excel VBA macro that creates the file list and the macro that renames the file name on the file list.

I made two Excel VBA macros. The macro named “Sub File_list” creates a file list in a folder where the xls file is stored and, The macro named “Sub Re_name” renames files using the file list. However, these macros cannot handle files in subfolders.These macros are show below, you can download the macro from this link.

【My Questions】

  • I want the “Sub File_list” to have the ability to list files in subfolders.
  • I want these “Sub Re_name” to have the ability to rename files in subfolders.(The renamed file shall stored in the same file as the original file.)

Assume that the files and folders shown in FIG. 1 are stored in the folders.
The “File_mng.xls” is the excel file that consists these macros.

enter image description here

At this time, when the “Sub File_list” is executed, all files stored in the same level (except “File_mng.xls” itself) are displayed on the spreadsheet (See Fig.2). However, sub folders and the files stored in that sub folders are not listed.

enter image description here

Note that, the backslash is garbled into the Yen sign because My Windows10 is Japanese version.

【The macros】
You can also download the macro from this link.

'Create a list of files in a specific folder
Sub File_list()
    Dim myFileName As String
    Dim FSO As Object
    Dim cnt

    myDir = ThisWorkbook.Path
    myDir = myDir & ""

    Set FSO = CreateObject("Scripting.FileSystemObject")
    cnt = FSO.GetFolder(myDir).Files.Count

    Range("A1").Value = "File name (Number of files " & cnt & ")"

    'Show hidden and system files
    myFileName = Dir(myDir & "*", vbHidden   vbSystem)

    While myFileName <> vbNullString
        If myFileName <> ThisWorkbook.Name Then
            Cells(Rows.Count, 1).End(xlUp).Offset(1).Value _
                = myDir
            Cells(Rows.Count, 2).End(xlUp).Offset(1).Value _
                = myFileName
        End If
        myFileName = Dir()

    Application.ScreenUpdating = True
End Sub

'Renames  files using the file list
Sub Re_name()
    myDir = ThisWorkbook.Path
    Nmax = (ActiveSheet.Range("A1").End(xlDown).Row)

    For n = 2 To Nmax
        yenn = ""

        If (Right(Cells(n, 1), 1) <> "") Then
            yenn = ""
        End If

        N1 = Cells(n, 1) & yenn & Cells(n, 2)
        N2 = Cells(n, 3) & Cells(n, 4) & Cells(n, 5) & Cells(n, 6)

        If N2 = "" Then
            N2 = N1
            N2 = myDir & "" & N2
        End If

        Name N1 As N2
    Next n
End Sub

P.S. I’m not very good at English, so I’m sorry if I have some impolite or unclear expressions. I welcome any corrections and English review. (You can edit my question and description to improve them)

Leave a Reply

Your email address will not be published. Required fields are marked *