Include todays date in export to excel

Mike Hughes

Registered User.
Local time
Today, 05:49
Joined
Mar 23, 2002
Messages
493
I would like to have the current date exported to excel every time this code is run. Could someone tell me how this would be done. Thanks

Code:
Sub btnAddNewDataToTbl1XLS_Click()
'************* Code Start *****************
'This code was originally written by Dev Ashish
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish

'Copy records to first 20000 rows
'in an existing Excel Workbook and worksheet
'
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "DataSheet"
Const conWKB_NAME = "C:\Documents and Settings\mike\Desktop\Tbl1XLS.xls"
  Set db = CurrentDb
  Set objXL = New Excel.Application
  Set rs = db.OpenRecordset("query2", dbOpenSnapshot)
  With objXL
    .Visible = True
    Set objWkb = .Workbooks.Open(conWKB_NAME)
    On Error Resume Next
    Set objSht = objWkb.Worksheets(conSHT_NAME)
    If Not Err.Number = 0 Then
      Set objSht = objWkb.Worksheets.Add
      objSht.Name = conSHT_NAME
    End If
    Err.Clear
    On Error GoTo 0
    intLastCol = objSht.UsedRange.Columns.Count
    With objSht
'      .Range(.Cells(20, 1), .Cells(conMAX_ROWS, _
'          intLastCol)).ClearContents
'      .Range(.Cells(20, 20), _
'        .Cells(1, rs.Fields.Count)).Font.Bold = True

        Dim lngWhichLineToStart As Long
        'Take the line count of Tbl1XLS.xls
        lngWhichLineToStart = DLookup("[LineCount]", "tblLineCountToXLS") + 2   ' 2 is for 2 lines below
        'Now export to excel
        .Range("A" & lngWhichLineToStart).CopyFromRecordset rs
        'You need to know how many lines your query2 exported which is equal to record count
        Dim lngExportedLines As Long
        lngExportedLines = rs.RecordCount + 2
        'Now you need to change the LineCount value for the next export
        DoCmd.RunSQL "UPDATE tblLineCountToXLS SET tblLineCountToXLS.LineCount = [LineCount]+ " & lngExportedLines & ";"

    End With
  End With
  Set objSht = Nothing
  Set objWkb = Nothing
  Set objXL = Nothing
  Set rs = Nothing
  Set db = Nothing
End Sub
 
Within Query2, add this field: DateAdded: Now()
If you just want the date, then use Date() rather than Now
If you want to write the date (or date and time) once at the top of where you will be adding the records from this query, then use this:
.Range("A" & lngWhichLineToStart) = Now()
Of course you will then need to change the line where you copy the query into Execl to look like this:
.Range("A" & (lngWhichLineToStart + 1)).CopyFromRecordset rs
 

Users who are viewing this thread

Back
Top Bottom