Search Folder and Sub Folders and display Information

[Blamo]

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

 

[Paul Ked]

Post your code (in CODE tags!)

 

[Blamo]

#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]

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!

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]

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:

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]

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]

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]

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]

If I try and use:

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

I receive an error message: