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!
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