VBA code create a list of files in subfolders

[12Rev79]

Dear Experts,

Please need your kind help, I have tried but no luck the code below. I need to extract excel files from my subfolders and create a list like the screenshot below

[ATTACH type="full" width="667px" size="1059x563"]123490[/ATTACH]
Secondly I need your help too, that when I click on my cmdbutton2 "Change HeaderName"
I need a code please that open the file with the "Y" and change the header on those file base from the column F5 and rename the sheetname as "Sheet1"

[ATTACH type="full" width="1013px" size="1573x75"]123491[/ATTACH] 

[ATTACH type="full" width="130px" size="170x81"]123493[/ATTACH]

Thanks a lot for your help in advance, appreciated.

12Rev79

 

[alansidman]

This should get you started.

Sub ListAllFile()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet
    Dim sPath As String
    Dim lrA As Long
    Dim lrB As Long

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ws = Worksheets.Add

    'Get the folder object associated with the directory
    sPath = InputBox("What is the full Path to Search?")
    Set objFolder = objFSO.GetFolder(sPath)
    ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & " are:"
    ws.Cells(1, 2).Value = "The files found have modified dates:"
    ws.Cells(1, 3).Value = "The file Size is:"

    'Loop through the Files collection
    For Each objFile In objFolder.Files
    'If objFile.Name Like "*.pdf" Then
        lrA = Range("A" & Rows.Count).End(xlUp).Row
        lrB = Range("B" & Rows.Count).End(xlUp).Row
        ws.Range("A" & lrA + 1).Value = objFile.Name
        ws.Range("B" & lrB + 1).Value = objFile.DateLastModified
        ws.Range("C" & lrB + 1).Value = objFile.Size
    'End If
    Next
    'ws.Cells(2, 1).Delete
    'Clean up!
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing

End Sub

 

[12Rev79]

This should get you started.

Sub ListAllFile()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet
    Dim sPath As String
    Dim lrA As Long
    Dim lrB As Long

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ws = Worksheets.Add

    'Get the folder object associated with the directory
    sPath = InputBox("What is the full Path to Search?")
    Set objFolder = objFSO.GetFolder(sPath)
    ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & " are:"
    ws.Cells(1, 2).Value = "The files found have modified dates:"
    ws.Cells(1, 3).Value = "The file Size is:"

    'Loop through the Files collection
    For Each objFile In objFolder.Files
    'If objFile.Name Like "*.pdf" Then
        lrA = Range("A" & Rows.Count).End(xlUp).Row
        lrB = Range("B" & Rows.Count).End(xlUp).Row
        ws.Range("A" & lrA + 1).Value = objFile.Name
        ws.Range("B" & lrB + 1).Value = objFile.DateLastModified
        ws.Range("C" & lrB + 1).Value = objFile.Size
    'End If
    Next
    'ws.Cells(2, 1).Delete
    'Clean up!
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing

End Sub

@alansidman Thanks for the help appreciated.