Old code = old date

[ghudson]

I have inherited an old Access 2 database that I have converted to Access 97. Everything was working great until we just upgraded from Windows 98 to XP. The below date function is returning the wrong date. It keeps returning 11/30/1979 for all files. It is using an old custom function to read a list of files in a directory and the below function is supposed to return the date each file was created. I am hoping that you can spot where the code needs to be tweaked for I have to use this function to avoid a major rewrite of the db.

Type OFSTRUCT
cBytes As String * 1
fFixedDisk As String * 1
nErrCode As Integer
szReserved As String * 4
szPath As String * 128
End Type

Global Const OF_EXIST = &H4000

Declare Function WinOpenFile Lib "KERNEL32.dll" Alias "OpenFile" (ByVal szFileName As String, OpenBuff As OFSTRUCT, ByVal flag As Integer) As Integer

Public Function GetFileDateTime(ByVal FileName As String) As Variant
On Error GoTo GetFileDateTime_Err

Dim ofs As OFSTRUCT
Dim iDate As Long
Dim iTime As Long

Const DAY_MASK = &H1F
Const MONTH_MASK = &H1E0
Const YEAR_MASK = &HFE00

Const SECOND_MASK = &H1F
Const MINUTE_MASK = &H7E0
Const HOUR_MASK = &HF800

If WinOpenFile(FileName, ofs, OF_EXIST) <> -1 Then
iDate = Asc(Mid$(ofs.szReserved, 2, 1)) * 256& + Asc(Mid$(ofs.szReserved, 1, 1))
iTime = Asc(Mid$(ofs.szReserved, 4, 1)) * 256& + Asc(Mid$(ofs.szReserved, 3, 1))
GetFileDateTime = DateSerial(((iDate And YEAR_MASK) \ &H200) + 1980, (iDate And MONTH_MASK) \ &H20, (iDate And DAY_MASK)) + TimeSerial((iTime And HOUR_MASK) \ &H800, (iTime And MINUTE_MASK) \ &H20, (iTime And SECOND_MASK) * 2)
Rem MsgBox GetFileDateTime
Else
GetFileDateTime = Null
End If

GetFileDateTime_Exit:
Exit Function

GetFileDateTime_Err:
MsgBox Err.Number & " " & Err.Description
Resume GetFileDateTime_Exit

End Function

I have tried padding the date and months but only made things worse.

Thanks in advance for your help!

 

[The_Doc_Man]

You may well have been "Gated" - by Bill Gates, the master of the incompatible update and the obsolete investment.

You are using an external function that is based on the FAT(16) structure and a REALLY old version of Windows and Access. The problem is the way that dates were stored on files, which is NOT the same way as dates were stored in Access data types.

The way a date is stored depends on a LOT of factors. Access 2 worked under Windows 3.1, for goodness sakes, which ran under version 6.? of MS-DOS! When you went to XP, did you change the format of the disk from FAT (meaning FAT16) to FAT32 - or another, even more modern format? Not to mention that XP and DOS use different base dates for date storage and stuff like that.

I am sorry to suggest this, but if I am going to advise you correctly, I must. It is entirely possible that this function will no longer work, period. You might have to rewrite the function in terms of a newer method. For instance, if you have the full path of the file, in VBA you can do the FileDateTime function to get the date/time a file was created or last modified. The good news is that you don't have to make an external reference for this function. It is built-in for Access 97 & later.

If you need something other than the created/last-modified date, you will have to use a new system call, I think.

 

[ritchieroo]

Set a reference to Microsoft Scripting Runtime... the File object exposes a DateCreated Property

Public Function GetFileCreatedDate(ByVal Filename As String) As Date
Dim oFSO As Scripting.FileSystemObject
Set oFSO = New Scripting.FileSystemObject
GetFileCreatedDate = oFSO.GetFile(Filename).DateCreated
Set oFSO = Nothing
End Function

Add any error handling you need.

 

[ghudson]

Thank for your help The_Doc_Man and ritchieroo !!!

My quick fix is to use the FileDateTime function in an update query. I am very thankful that I did not have to program in Access 2!