Macro VBA Getting the footer/header from multiple files with subfolders

accountant_babe

New Member
Joined
Jul 7, 2014
Messages
7
I have used this site for most of the pieces of this marco so thank you to the community!!

One last issue

The purpose is to get the footer from multiple files. This is the only reference I have for which employee prepared the sheets (templates were created and managers signed them, so I can't use created by or last saved).

My colunm that prints the footer ( or header could be retrieved), right footer in this case, returns "&F" in the cell.

I believe this is a formatting issue. I know how to deal with it if I was putting a footer in but not when I am copying it out.

Thank you in advance!

Rich (BB code):
'Force the explicit delcaration of variables
 Option Explicit
 
Sub ListFilesAndFooters()
 
    '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"
     Range("H1").Value = "A1 Value" ' Was the file actually opened?
     
     '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
     Dim strFootRight As String
        Dim wbk As Workbook 'added
'Application.ScreenUpdating = False ' Getting Fancy
     
     '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
     
     Set wbk = Workbooks.Open(objFile) ' added
     
         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
         
        Cells(NextRow, "G") = ActiveSheet.PageSetup.CenterFooter '<<<<<<< Prints "&F" instead of a name of employee
        
        Cells(NextRow, "H").Value = ActiveSheet.Cells(1, "A")
         NextRow = NextRow + 1
         
         wbk.Close savechanges:=False  ''added
     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
    ' Application.ScreenUpdating = True ' Turn the screen back to updating
 End Sub
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

Forum statistics

Threads
1,215,381
Messages
6,124,614
Members
449,175
Latest member
Anniewonder

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top