Printing date values in footers

A partial solution

I don't know how to access those dates in VBA, but there's probably an easy way. Alternately, you could put those dates in cells on your worksheet and access them with:

Sheets("Sheet1").Range("A1")

But in the following code I just have ?????? for the values I don't know how to get.

Sub Footers()
For Each Sh In Sheets
Sh.Activate
ActiveSheet.PageSetup.RightFooter = "Created on: " & ?????? & Chr(10) & "Last Modified On: " & ?????? & Chr(10) & "Printed on: " & ??????
Next Sh
End Sub

-Ben

Re: A partial solution

Following on from Ben....to get the dates;

Todays date = just use Now() and appropriate format

LAST MODIFIED;

Function Filedate_LastMod(Filename As String) As String
Dim FileDate As Double

On Error Resume Next
FileDate = FileDateTime(Filename)
If Err.Number = 0 Then
Filedate_LastMod = Format(FileDate, "dd/mm/yy hh:mm:ss")
Else
Filedate_LastMod = "Error"
End If
End Function

TO GET CREATION DATE:
Use Johns function
'32 bit Windows declarations
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Declare Function FileTimeToLocalFileTime Lib "kernel32" _
(lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long

Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Long
End Type

Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type

Private Function FileDate(FT As FILETIME) As String
' convert the FILETIME to LOCALTIME, then to SYSTEMTIME type
Dim ST As SYSTEMTIME
Dim LT As FILETIME
Dim t As Long
Dim ds As Double
Dim ts As Double
t = FileTimeToLocalFileTime(FT, LT)
t = FileTimeToSystemTime(LT, ST)
If t Then
ds = DateSerial(ST.wYear, ST.wMonth, ST.wDay)
ts = TimeSerial(ST.wHour, ST.wMinute, ST.wSecond)
ds = ds + ts
If ds > 0 Then
FileDate = Format$(ds, "dd/mm/yy hh:mm:ss")
Else
FileDate = "(no date)"
End If
End If
End Function

Re: A partial solution

Thanks for the help, but I am still having trouble icluding these function in the right footer. Any suggestions you might have would be appreciated.

Re: A partial solution

Rick
Code as follows;
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long

Declare Function FileTimeToLocalFileTime Lib "kernel32" _
(lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long

Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Long
End Type

Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type

'example of how to use
Private Sub ShowFileInfo()
' This subroutine demonstrates the technique
Dim hFile As Long
Dim WFD As WIN32_FIND_DATA
Dim FullName As String
Dim Created As String
Dim LastWrite As String

' FullName is the path and filename
' Substitute any valid file and path
FullName = ActiveWorkbook.FullName
hFile = FindFirstFile(FullName, WFD)

If hFile > 0 Then
Created = FileDate(WFD.ftCreationTime)
MsgBox "File Created: " & Created, vbInformation, FullName
Else
MsgBox "File not found.", vbCritical, FullName
End If
End Sub

'LAST MODIFIED;
Function Filedate_LastMod(Filename As String) As String
Dim FileDate As Double

On Error Resume Next
FileDate = FileDateTime(Filename)
If Err.Number = 0 Then
Filedate_LastMod = Format(FileDate, "dd/mm/yy hh:mm:ss")
Else
Filedate_LastMod = "Error"
End If
End Function

Function FileDate(FT As FILETIME) As String
' convert the FILETIME to LOCALTIME, then to SYSTEMTIME type
Dim ST As SYSTEMTIME
Dim LT As FILETIME
Dim t As Long
Dim ds As Double
Dim ts As Double
t = FileTimeToLocalFileTime(FT, LT)
t = FileTimeToSystemTime(LT, ST)
If t Then
ds = DateSerial(ST.wYear, ST.wMonth, ST.wDay)
ts = TimeSerial(ST.wHour, ST.wMinute, ST.wSecond)
ds = ds + ts
If ds > 0 Then
FileDate = Format$(ds, "dd/mm/yy hh:mm:ss")
Else
FileDate = "(no date)"
End If
End If
End Function

Sub Create_RghtFooter_Dates()
Dim sh
Dim Created As String
Dim Modifiedon As String
Dim hFile As Long
Dim WFD As WIN32_FIND_DATA
Dim FullName As String

' FullName is the path and filename
' Substitute any valid file and path
FullName = ActiveWorkbook.FullName
hFile = FindFirstFile(FullName, WFD)

If hFile > 0 Then
Created = FileDate(WFD.ftCreationTime)
Else
Created = "File not found."
End If

Modifiedon = Filedate_LastMod(FullName)

For Each sh In ActiveWorkbook.Sheets
With sh
.PageSetup.RightFooter = _
"Created On: " & Created & Chr(10) & _
"Last Modified On: " & Modifiedon & Chr(10) & _
"Printed On: " & Now()
End With
Next sh
End Sub

Ivan