Wrong Date from File creation routine 1

[vba317]

I have written a module that will take the date a file is created and put the value into a variable. The file in question was created on 1/13/2014. Once I determine the date the file is created I update a table. The issue happens when I update the table. The value that goes into the table is 12/30/1899. I was hoping I could get some assistance in resolving this issue. When I step through the code
At this point dCreateDate = oFS.GetFile(strFilename).DateCreated I get 1/13/2014 4:45:57 PM
At this point dCreateDate = Format(dCreateDate, "dd/mm/yyyy") 1/13/2014
At this point strSQL = "UPDATE zzz_CalcAR SET zzz_CalcAR.AgeDate = " & dCreateDate I get 1/13/2014
But then I look in the table and I see 12/30/1899

Tom

Public Function xlReadDateCreated(dCreateDate As Date)
'Call xlReadDateCreated(dCreateDate)
    Dim oFS As Object
    Dim strFilename As String
    Dim strFileLoc As String
    Dim strSQL As String
    Dim rst As DAO.Recordset
    Dim i As Integer
    Dim strCSFile As String
    'Put your filename here
    strFileLoc = "\\server\E\Balout\"

    strSQL = "SELECT dbo_rpt_FYInfo.uci, dbo_rpt_FYInfo.rptpddiff, dbo_rpt_FYInfo.csfile " & _
             "FROM dbo_rpt_FYInfo " & _
             "WHERE dbo_rpt_FYInfo.uci='UCM' AND dbo_rpt_FYInfo.rptpddiff=1;"
    Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
    If Not rst.EOF Then    ' Make sure not empty set
        With rst
            .MoveLast
            .MoveFirst
        End With
        For i = 1 To rst.RecordCount
            strCSFile = (rst![csfile])
        Next
        strFilename = strFileLoc & strCSFile
        'This creates an instance of the MS Scripting Runtime FileSystemObject class
        Set oFS = CreateObject("Scripting.FileSystemObject")
        dCreateDate = oFS.GetFile(strFilename).DateCreated
        dCreateDate = Format(dCreateDate, "dd/mm/yyyy")
        Set oFS = Nothing
    End If

-----Function-------

Public Function ProcessQueries()
Dim strSQL As String
Dim rst As DAO.Recordset
Dim i As Integer
Dim dCreateDate As Date

With DoCmd
        .SetWarnings False
        .OpenQuery "000_ClearAgingReport"
        .OpenQuery "000_ClearARCalc"
        .OpenQuery "000_ClearImport"
        .OpenQuery "000_ClearPatSummaryTotals"
        .OpenQuery "000_Clear_PatSummary"
        .OpenQuery "010_PostAR"
        .OpenQuery "011_SetInsName"
        .OpenQuery "012_SetPatientData"
        Call xlReadDateCreated(dCreateDate)
        
        strSQL = "UPDATE zzz_CalcAR SET zzz_CalcAR.AgeDate = " & dCreateDate
        CurrentDb.Execute (strSQL)
        
        '.OpenQuery "020_UpdateAgingDate"
        .OpenQuery "030_CalcAgingDays"
        .OpenQuery "040_SetBucket"
        .OpenQuery "050_GetPatSummaryTotals"
        .OpenQuery "060_MakePatSummaryEntries"
        .OpenQuery "070_PostAgingReportData"
        .OpenQuery "080_UpdateReportBucketEntries"
        .SetWarnings True
    End With
End Function

 

[PHV]

I'd use this:

strSQL = "UPDATE zzz_CalcAR SET zzz_CalcAR.AgeDate=#" & Format(oFS.GetFile(strFilename).DateCreated, "yyyy-mm-dd") & "#"

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Andrzejek]

Also, don't forget:
[tt]
strSQL = "UPDATE zzz_CalcAR SET zzz_CalcAR.AgeDate = #1/13/2014#[red] WHERE ...[/red]"
[/tt]
Unless you want to update ALL records in a table with the same date.

Have fun.

---- Andy

 

[vba317]

Using the above code I get a runtime error 91 Object variable or with block not set.

 

[PHV]

OK, in your original code, replace this:
dCreateDate = oFS.GetFile(strFilename).DateCreated
dCreateDate = Format(dCreateDate, "dd/mm/yyyy")
With this:
dCreateDate = Format(oFS.GetFile(strFilename).DateCreated, "yyyy-mm-dd")

And this:
strSQL = "UPDATE zzz_CalcAR SET zzz_CalcAR.AgeDate = " & dCreateDate
with this:
strSQL = "UPDATE zzz_CalcAR SET zzz_CalcAR.AgeDate=#" & dCreateDate & "#"

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[dhookom]

The reason you were seeing "12/30/1899" is because the "/" were treated like divisions.
1/22/2014 is 1 divided by 22 divided by 2014 = 0.000022569
0.000022569 in a date/time field is the equivalent of very early in the morning on December 30, 1899 (the Microsoft beginning of time).


Duane
Hook'D on Access
MS Access MVP

 

[vba317]

Thanks PHV,
I ended up doing things a little differently but I got the results I needed. Thanks for your help!

From original function

Public Function ProcessQueries()
Dim strSQL As String
Dim rst As DAO.Recordset
Dim i As Integer
Dim dCreateDate As Date
Dim strCreateDate As String
Dim oFS As Object
Dim strFilename As String
Dim strFileLoc As String
Dim strCSFile As String
   
With DoCmd
        .SetWarnings False
        .OpenQuery "000_ClearAgingReport"
        .OpenQuery "000_ClearARCalc"
        .OpenQuery "000_ClearImport"
        .OpenQuery "000_ClearPatSummaryTotals"
        .OpenQuery "000_Clear_PatSummary"
        .OpenQuery "010_PostAR"
        .OpenQuery "011_SetInsName"
        .OpenQuery "012_SetPatientData"
        'Replaces 020_UpdateAgingDate query
        Call xlReadDateCreated(dCreateDate, strCreateDate)
        strSQL = "UPDATE zzz_CalcAR SET zzz_CalcAR.AgeDate =" & strCreateDate
                CurrentDb.Execute (strSQL)
        .OpenQuery "030_CalcAgingDays"
        .OpenQuery "040_SetBucket"
        .OpenQuery "050_GetPatSummaryTotals"
        .OpenQuery "060_MakePatSummaryEntries"
        .OpenQuery "070_PostAgingReportData"
        .OpenQuery "080_UpdateReportBucketEntries"
        .SetWarnings True
    End With
End Function




Module
Public Function xlReadDateCreated(strCreateDate As String)
'Call xlReadDateCreated(strCreateDate)
    Dim oFS As Object
    Dim strFilename As String
    Dim strFileLoc As String
    Dim strSQL As String
    Dim dCreateDate As Date
    Dim rst As DAO.Recordset
    Dim i As Integer
    Dim strCSFile As String
   
    strFileLoc = "\\server\E\Balout\"
    strSQL = "SELECT dbo_rpt_FYInfo.uci, dbo_rpt_FYInfo.rptpddiff, dbo_rpt_FYInfo.csfile " & _
             "FROM dbo_rpt_FYInfo " & _
             "WHERE dbo_rpt_FYInfo.uci='UCM' AND dbo_rpt_FYInfo.rptpddiff=1;"
    Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
    If Not rst.EOF Then    ' Make sure not empty set
        With rst
            .MoveLast
            .MoveFirst
        End With
        For i = 1 To rst.RecordCount
            strCSFile = (rst![csfile])
        Next
        strFilename = strFileLoc & strCSFile
        'This creates an instance of the MS Scripting Runtime FileSystemObject class
        Set oFS = CreateObject("Scripting.FileSystemObject")
        dCreateDate = oFS.GetFile(strFilename).DateCreated
        dCreateDate = Format(dCreateDate, "yyyy-mm-dd")
        strCreateDate = "#" & dCreateDate & "#"
        Set oFS = Nothing
    End If
    End Function