Mike Hughes
Registered User.
- Local time
- Today, 09:07
- 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