Search Folder and Sub Folders and display Information

Blamo

New Member
Joined
Nov 15, 2019
Messages
6
I found this great article (http://www.xl-central.com/list-the-files-in-a-folder-and-subfolders.html) and it is exactly what I needed.



I’ve tweaked it to reflect my circumstances, my issue is, I’m trying to pull certain cell Information rather than all the information about the file itself.



For example, instead of having information like when the file was last accessed being displayed, I would like to get the value of cell A8 in all the excel files the search finds. I’ve tried replacing “objFile.DateLastAccessed” with “Range(“A8”).value” but nothing appears. I’m also not getting any errors.



Hopefully this makes sense, I haven’t drastically changed the code in the link, I’ve essentially changed the headings created and the top file location. It still works, the new headings appear and the file information I still want is being displayed, It’s just the pesky cell information that isn’t being produced.



I have a hunch I’m missing a variable/ dim command but I’m not sure.

Thanks again and I hope I hear from someone soon.



Best regards,



Blamo
 

Blamo

New Member
Joined
Nov 15, 2019
Messages
6
#Paul Ked

Hi Paul,

I'm not sure where the Code Tag area is but please find the code I'm trying to use below:

'Force the explicit delcaration of variables
Option Explicit
Sub ListFiles()
'Set a reference to Microsoft Scripting Runtime by using
'Tools > References in the Visual Basic Editor (Alt+F11)

'Declare the variables
Dim objFSO As Scripting.FileSystemObject
Dim objTopFolder As Scripting.Folder
Dim strTopFolderName As String

'Insert the headers for Columns A through M
Range("A1").Value = "Customer P.O:"
Range("B1").Value = "Sales Order Number:"
Range("C1").Value = "Works Order Number:"
Range("D1").Value = "Spirax Purchase Order:"
Range("E1").Value = "Date Despatched Est'd:"
Range("F1").Value = "Date Est'd Return:"
Range("G1").Value = "Sub-Contractor:"
Range("H1").Value = "Sub-Contractor Ref No:"
Range("I1").Value = "Sub-Con Report Received:"
Range("J1").Value = "Reports Verified By:"
Range("K1").Value = "Date Booked Back In:"
Range("L1").Value = "Date Last Modified:"
Range("M1").Value = "File Name:"
Range("N1").Value = "Link To File:"

'Assign the top folder to a variable
strTopFolderName = "Desktop\Eng Folder"

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the top folder
Set objTopFolder = objFSO.GetFolder(strTopFolderName)

'Call the RecursiveFolder routine
Call RecursiveFolder(objTopFolder, True)

'Change the width of the columns to achieve the best fit
Columns.AutoFit

End Sub
Sub RecursiveFolder(objFolder As Scripting.Folder, _
IncludeSubFolders As Boolean)
'Declare the variables
Dim objFile As Scripting.File
Dim objSubFolder As Scripting.Folder
Dim NextRow As Long

'Find the next available row
NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1

'Loop through each file in the folder
For Each objFile In objFolder.Files
Cells(NextRow, "A").Value = Range("AD1").Value
Cells(NextRow, "B").Value = Range("AD2").Value
Cells(NextRow, "C").Value = Range("AD3").Value
Cells(NextRow, "D").Value = Range("AD4").Value
Cells(NextRow, "E").Value = Range("AD5").Value
Cells(NextRow, "F").Value = Range("AD6").Value
Cells(NextRow, "G").Value = Range("AD7").Value
Cells(NextRow, "H").Value = Range("AD8").Value
Cells(NextRow, "I").Value = Range("AD9").Value
Cells(NextRow, "J").Value = Range("AD10").Value
Cells(NextRow, "K").Value = Range("AD11").Value
Cells(NextRow, "L").Value = objFile.DateLastModified
Cells(NextRow, "M").Value = objFile.Name
Cells(NextRow, "N").Value = objFile.Name
NextRow = NextRow + 1
Next objFile

'Loop through files in the subfolders
If IncludeSubFolders Then
For Each objSubFolder In objFolder.SubFolders
Call RecursiveFolder(objSubFolder, True)
Next objSubFolder
End If

End Sub


Thanks for taking a look
 

Paul Ked

Active Member
Joined
Jun 4, 2015
Messages
441
Hi. You didn't say which sub you wanted the "A8" in so I've put it in both. I'm guessing you may have made a typo in your attempt as it should work ok!

Code:
Sub ListFiles()
'Set a reference to Microsoft Scripting Runtime by using
'Tools > References in the Visual Basic Editor (Alt+F11)

'Declare the variables
    Dim objFSO As Scripting.FileSystemObject
    Dim objTopFolder As Scripting.Folder
    Dim strTopFolderName As String

'Insert the headers for Columns A through M
    Range("A1").Value = "Customer P.O:"
    Range("B1").Value = "Sales Order Number:"
    Range("C1").Value = "Works Order Number:"
    Range("D1").Value = "Spirax Purchase Order:"
    Range("E1").Value = "Date Despatched Est'd:"
    Range("F1").Value = "Date Est'd Return:"
    Range("G1").Value = "Sub-Contractor:"
    Range("H1").Value = "Sub-Contractor Ref No:"
    Range("I1").Value = "Sub-Con Report Received:"
    Range("J1").Value = "Reports Verified By:"
    Range("K1").Value = "Date Booked Back In:"
'>>>You may have to put the sheet name before Range                     <<<
'>>>eg Sheets("Sheet1").Range("A8").Value if it is on a different sheet.<<<
    Range("L1").Value = Range("A8").Value '"Date Last Modified:"
    Range("M1").Value = "File Name:"
    Range("N1").Value = "Link To File:"

'Assign the top folder to a variable
    strTopFolderName = "Desktop\Eng Folder"

'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the top folder
    Set objTopFolder = objFSO.GetFolder(strTopFolderName)

'Call the RecursiveFolder routine
    Call RecursiveFolder(objTopFolder, True)

'Change the width of the columns to achieve the best fit
    Columns.AutoFit

End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder, IncludeSubFolders As Boolean)
'Declare the variables
    Dim objFile As Scripting.File
    Dim objSubFolder As Scripting.Folder
    Dim NextRow As Long

'Find the next available row
    NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1

'Loop through each file in the folder
    For Each objFile In objFolder.Files
        Cells(NextRow, "A").Value = Range("AD1").Value
        Cells(NextRow, "B").Value = Range("AD2").Value
        Cells(NextRow, "C").Value = Range("AD3").Value
        Cells(NextRow, "D").Value = Range("AD4").Value
        Cells(NextRow, "E").Value = Range("AD5").Value
        Cells(NextRow, "F").Value = Range("AD6").Value
        Cells(NextRow, "G").Value = Range("AD7").Value
        Cells(NextRow, "H").Value = Range("AD8").Value
        Cells(NextRow, "I").Value = Range("AD9").Value
        Cells(NextRow, "J").Value = Range("AD10").Value
        Cells(NextRow, "K").Value = Range("AD11").Value
'>>>You may have to put the sheet name before Range               <<<
'>>>eg Sheets("Sheet1").Range("A8") if it is on a different sheet.<<<
        Cells(NextRow, "L").Value = Range("A8").Value 'objFile.DateLastModified
        Cells(NextRow, "M").Value = objFile.Name
        Cells(NextRow, "N").Value = objFile.Name
        NextRow = NextRow + 1
    Next objFile

'Loop through files in the subfolders
    If IncludeSubFolders Then
        For Each objSubFolder In objFolder.SubFolders
            Call RecursiveFolder(objSubFolder, True)
        Next objSubFolder
    End If

End Sub
The button for code tags seems to have disappeared, but you enclose the code with
{CODE}
insert your code here
{/CODE}
replacing the curly brackets with square.
 

Blamo

New Member
Joined
Nov 15, 2019
Messages
6
Hi Paul,

Thank you again but I'm a little lost, it is Monday and have only had 3 coffees so far :)

The first section of the code where it builds the columns seems to be fine but you have added a few additional lines but have also noticed you have added a few additional lines where the code searches and gets information:

VBA Code:
Sub ListFiles()
'Set a reference to Microsoft Scripting Runtime by using
'Tools > References in the Visual Basic Editor (Alt+F11)

'Declare the variables
    Dim objFSO As Scripting.FileSystemObject
    Dim objTopFolder As Scripting.Folder
    Dim strTopFolderName As String

'Insert the headers for Columns A through M
    Range("A1").Value = "Customer P.O:"
    Range("B1").Value = "Sales Order Number:"
    Range("C1").Value = "Works Order Number:"
    Range("D1").Value = "Spirax Purchase Order:"
    Range("E1").Value = "Date Despatched Est'd:"
    Range("F1").Value = "Date Est'd Return:"
    Range("G1").Value = "Sub-Contractor:"
    Range("H1").Value = "Sub-Contractor Ref No:"
    Range("I1").Value = "Sub-Con Report Received:"
    Range("J1").Value = "Reports Verified By:"
    Range("K1").Value = "Date Booked Back In:"
[COLOR=rgb(184, 49, 47)]'>>>You may have to put the sheet name before Range                     <<<
'>>>eg Sheets("Sheet1").Range("A8").Value if it is on a different sheet.<<<
    Range("L1").Value = Range("A8").Value '"Date Last Modified:"[/COLOR]
    Range("M1").Value = "File Name:"
    Range("N1").Value = "Link To File:"

'Assign the top folder to a variable
    strTopFolderName = "Desktop\Eng Folder"

'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the top folder
    Set objTopFolder = objFSO.GetFolder(strTopFolderName)

'Call the RecursiveFolder routine
    Call RecursiveFolder(objTopFolder, True)

'Change the width of the columns to achieve the best fit
    Columns.AutoFit

End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder, IncludeSubFolders As Boolean)
'Declare the variables
    Dim objFile As Scripting.File
    Dim objSubFolder As Scripting.Folder
    Dim NextRow As Long

'Find the next available row
    NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1

'Loop through each file in the folder
    For Each objFile In objFolder.Files
        Cells(NextRow, "A").Value = Range("AD1").Value
        Cells(NextRow, "B").Value = Range("AD2").Value
        Cells(NextRow, "C").Value = Range("AD3").Value
        Cells(NextRow, "D").Value = Range("AD4").Value
        Cells(NextRow, "E").Value = Range("AD5").Value
        Cells(NextRow, "F").Value = Range("AD6").Value
        Cells(NextRow, "G").Value = Range("AD7").Value
        Cells(NextRow, "H").Value = Range("AD8").Value
        Cells(NextRow, "I").Value = Range("AD9").Value
        Cells(NextRow, "J").Value = Range("AD10").Value
        Cells(NextRow, "K").Value = Range("AD11").Value
[COLOR=rgb(184, 49, 47)]'>>>You may have to put the sheet name before Range               <<<
'>>>eg Sheets("Sheet1").Range("A8") if it is on a different sheet.<<<
        Cells(NextRow, "L").Value = Range("A8").Value 'objFile.DateLastModified[/COLOR]
        Cells(NextRow, "M").Value = objFile.Name
        Cells(NextRow, "N").Value = objFile.path
        NextRow = NextRow + 1
    Next objFile

'Loop through files in the subfolders
    If IncludeSubFolders Then
        For Each objSubFolder In objFolder.SubFolders
            Call RecursiveFolder(objSubFolder, True)
        Next objSubFolder
    End If

End Sub

Apologies if I'm not explaining myself correctly, cell A8 was only an example in my initial question to get m query across, the cell values Im actually tying to get are listed in column "AD". The sheets it will need to look at are named differently, would this cause an issue?

Thanks again
 

Paul Ked

Active Member
Joined
Jun 4, 2015
Messages
441
I think you need to start reading about the basics of VBA! The comment lines that start with a ' are just comments... they have nothing to do with the working of the code. If any cells are on different sheets then yes, Sheet names are vital! See my example in the comments.
 

Blamo

New Member
Joined
Nov 15, 2019
Messages
6
Hi Paul,

Thanks for your help, I see your added comments are only just comments but I'm not following what you are suggesting, are you suggesting the following, assuming the information is on sheet1 on all files:

Cells(NextRow, "A").Value = Sheets("Sheet1").Range("AD1").Value

Thanks again
 

Blamo

New Member
Joined
Nov 15, 2019
Messages
6
Also, could you help with the objFile.path line for column N, this displays the path but I would like to have the path as a hyperlink if possible?
 

Blamo

New Member
Joined
Nov 15, 2019
Messages
6
If I try and use:

Cells(NextRow, "A").Value = Sheets("Sheet1").Range("AD1").Value

I receive an error message:

1574073551515.png
 

Forum statistics

Threads
1,078,353
Messages
5,339,717
Members
399,320
Latest member
sut3k

Some videos you may like

This Week's Hot Topics

Top