Macro to Retrive Footer information from multiple files in a folder

[accountant_babe]

Hi guys! I am new here and in a new job! Very exciting!

I am trying to get the footer information from multiple Excel files (about 600) in a folder that has sub folders.
I need the file name and file path as well.

I found two web pages that I have been struggling to combine.
1. Applying the same footer to multiple files Copying Headers and Footers (Microsoft Excel)
2. Getting the file name for each tab Files in a Directory in Excel VBA - Easy Excel Macros

Both aren't really what I need.

Any suggestions would be greatly appriciated.<3

 

[AlphaFrog]

Here's a good routine to list all the files in a folder and its sub-folders.
List the Files in a Folder and SubFolders

Not sure what you're looking for with the footers.

 

[accountant_babe]

Here's a good routine to list all the files in a folder and its sub-folders.
List the Files in a Folder and SubFolders

Not sure what you're looking for with the footers.

Thank you! I need make a list of the footers to the assosiated files. Every footer contains the name of the employee that prepared the file. (Templates were created and passed out, employees prepared them and a final manager signed them).

 

[AlphaFrog]

Thank you! I need make a list of the footers to the assosiated files. Every footer contains the name of the employee that prepared the file. (Templates were created and passed out, employees prepared them and a final manager signed them).

Does that mean all the footers are in the same row on the same sheet for each file?

 

[accountant_babe]

The footers are added with the "Insert header/footer" command from the ribbon, not directly typed into a cell.

Is there anyway to use a macro to pull this information from all the files within the folder into one specific list?

Thank you again!

 

[AlphaFrog]

I think you would have to open each file and get its footer

There are Left\Center\Right footers. This code reads the footers from Sheet(1) of the opened file

With Sheets(1).PageSetup
        lh = .LeftFooter
        cf = .CenterFooter
        rf = .RightFooter
    End With

 

[accountant_babe]

This is what I've come up with. I am having trouble with the highlighted line. I am getting a compiler error.

        '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 F
     Range("A1").Value = "File Name"
     Range("B1").Value = "File Size"
     Range("C1").Value = "File Type"
     Range("D1").Value = "Date Created"
     Range("E1").Value = "Date Last Accessed"
     Range("F1").Value = "Date Last Modified"
     Range("G1").Value = "Footer"
     
     'Assign the top folder to a variable
     strTopFolderName = "M:\Corporate Accounting\Quarterly Binder\2013 Q4\B - Intercompany\"
     
     '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 = objFile.Name
         Cells(NextRow, "B").Value = objFile.Size
         Cells(NextRow, "C").Value = objFile.Type
         Cells(NextRow, "D").Value = objFile.DateCreated
         Cells(NextRow, "E").Value = objFile.DateLastAccessed
         Cells(NextRow, "F").Value = objFile.DateLastModified
        [COLOR=#ff0000] Cells(NextRow, "G").Value = cbjFile.Name. ' <<<<<<<< Problem is here <<<[/COLOR]
         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

[/QUOTE]