Function to insert CREATE DATE?

[dmagnus]

I am using some VB code to do several things, one of which is to insert a line in an excel field that reads "Created by Joe Shmo on XX/XX/XXXX", where the X's are the file's create date. Is there a function to get this date programatically?

Thanks in advance for your responses. Dan

 

[dmagnus]

Well, the code didn't error on me, but the date says created on 10/14/1996! Time warp! Any idea where it's getting this time from? I know the file was created a week or two ago.

Thanks.

 

[Damon Ostrander]

Hi Dan,

I'm sorry that I forgot to follow up on this earlier to make sure you had it solved. I just tried it with one of my Excel files and had the same problem with the Creation Date being bogus, but a different date from yours. I checked the microsoft.com knowledge base and didn't find any reference to this problem, but find it hard to believe we are the first to come across it. I'll research it more tomorrow when I have some time.

Damon

 

[Damon Ostrander]

Hi again Dan,

I have done a bit of investigation and it now appears that the Creation Date returned by the workbook's BuiltInDocumentProperties property accessed via VBA is very often not the same as the Creation Date that appears in the Files > Properties sheet. The latter is the same as the creation date that appears in the File Explorer as a file property. The BuiltInDocumentProperties creation date is the date the template or file on which the workbook is based was created. This date is not updated by a SaveAs which changes the name of the workbook. I guess you could look at it as one giving the Workbook's creation date, and the other giving the file's creation date.

There are Windows API calls that can be used to get the file's creation date from VBA. I suggest John Walkenbach's code at:

http://j-walk.com/ss/excel/tips/tip57.htm

Keep Excelling.

Damon

 

[dmagnus]

Thanks, Damon. One last question. Armed with this knowledge, how do I get this date into the text string I am trying to use in my original question above? I'm not too versed in VB so I need some more help.

Thanks again.

 

[Damon Ostrander]

Hi again Dan,

Here is some code you can add to the code module containing the code provided by John Walkenbach. This enables you to call CreationDate from a worksheet cell similiarly to the DocProperty function. For example, you could call it like this:

=CreationDate()

which returns a date value so the cell must be formatted as Date. But you could also use it to return a string value like this:

="Prepared on " & TEXT(CreationDate(),"mm/dd/yy hh:mm") & " by Dan Magnus"

Function CreationDate() As Date
'   This function returns the creation date of this workbook
    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)
        CreationDate = CDate(Created)
    Else
        CreationDate = CVErr(xlErrNull)
    End If
End Function

Damon

 

[dmagnus]

Sorry to bug you again, Damon, (or whoever is reading this thread). I've copied both "chunks" of code into their own module as follows: (as copied from the links provided above)

'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, "mm/dd/yy hh:mm:ss")
        Else
            FileDate = "(no date)"
        End If
    End If
End Function

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

Function CreationDate() As Date
'   This function returns the creation date of this workbook
    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)
        CreationDate = CDate(Created)
    Else
        CreationDate = CVErr(xlErrNull)
    End If
End Function

I then run my macro and get an error that reads, "Compile Error: Sub or function not defined", and the word "TEXT" in the text string you suggested above is highlighted in blue. My macro code in which I'm trying to solve this problem is:

Sub Add_Rpt_Footer_Rental_Data_All_Channels()
'
' Macro8 Macro
' Macro recorded 10/4/2006 by Daniel B Magnus
'

' Go to last row of data
'Range("A" & ActiveCell.SpecialCells(xlLastCell).Row).Select
Range("A" & Rows.Count).End(xlUp).Offset(4).Select
    
' Enter data in the next 3 rows
    ActiveCell.FormulaR1C1 = _
        "Distribution: B.Curtin, B.Dvorcek, G.Rusk, R.Buyno, A.Umali, S.Lee, H.Campbell, J.Collins, J.Howell, D.Baird, M.Kapilla, G.Drozda, D.Thro, C.Amschler"
    ActiveCell.Font.Size = 8
    ActiveCell.Offset(1, 0).Select
    ActiveCell = "Prepared on " & Text(CreationDate(), "mm/dd/yy hh:mm") & " by Dan Magnus"
    ActiveCell.Font.Size = 8
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = _
        "=""File located at: "" & SUBSTITUTE(SUBSTITUTE(LEFT(CELL(""filename""),FIND(""]"",CELL(""filename""))),""["",""""),""]"","""")"
    ActiveCell.Font.Size = 8
        
End Sub

Any idea why the compile error? Thanks again!

 

[dmagnus]

I figured it out. Sorry about the long post above. I simply removed the "TEXT" and the formatting out of the text string and it worked.

Thanks for the help!