The template is located in a folder titled "C:\UGH\"
The template name is "Follow Up Orders mmddyyyy.xlsx"
The template sheet name is "Orders"
The MS Access table is named "FollowUpOrders"
I want the code to open the template, drop the contents of "FollowUpOrders" into the "Orders" tab, then save the file as "Follow Up Orders 04122018", changing the date to be the current date of whenever it runs, leaving the original template intact.
I sincerely appreciate any and all help you can toss my way!
Expand|Select|Wrap|Line Numbers
- Option Compare Database
- Function ExportToExcel()
- Dim lngColumn As Long
- Dim xlx As Object, xlw As Object, xlsx As Object, xlc As Object
- Dim dbs As DAO.Database
- Dim rst As DAO.Recordset
- Dim blnEXCEL As Boolean, blnHeaderRow As Boolean
- blnEXCEL = False
- ' Replace True with False if you do not want the first row of
- ' the worksheet to be a header row (the names of the fields
- ' from the recordset)
- blnHeaderRow = True
- ' Establish an EXCEL application object
- On Error Resume Next
- Set xlx = GetObject(, "Excel.Application")
- If Err.Number <> 0 Then
- Set xlx = CreateObject("Excel.Application")
- blnEXCEL = True
- End If
- Err.Clear
- On Error GoTo 0
- ' Change True to False if you do not want the workbook to be
- ' visible when the code is running
- xlx.Visible = True
- ' Replace C:\Filename.xlsx with the actual path and filename
- ' of the EXCEL file into which you will write the data
- Set xlw = xlx.Workbooks.Open("C:\UGH\Follow Up Orders mmddyyyy.xlsx")
- ' Replace WorksheetName with the actual name of the worksheet
- ' in the EXCEL file
- ' (note that the worksheet must already be in the EXCEL file)
- Set xlsx = xlw.Worksheets("Orders")
- ' Replace A1 with the cell reference into which the first data value
- ' is to be written
- Set xlc = xlsx.Range("A1") ' this is the first cell into which data go
- Set dbs = CurrentDb()
- ' Replace QueryOrTableName with the real name of the table or query
- ' whose data are to be written into the worksheet
- Set rst = dbs.OpenRecordset("FollowUpOrders", dbOpenDynaset, dbReadOnly)
- If rst.EOF = False And rst.BOF = False Then
- rst.MoveFirst
- If blnHeaderRow = True Then
- For lngColumn = 0 To rst.Fields.Count - 1
- xlc.Offset(0, lngColumn).value = rst.Fields(lngColumn).Name
- Next lngColumn
- Set xlc = xlc.Offset(1, 0)
- End If
- ' write data to worksheet
- Do While rst.EOF = False
- For lngColumn = 0 To rst.Fields.Count - 1
- xlc.Offset(0, lngColumn).value = rst.Fields(lngColumn).value
- Next lngColumn
- rst.MoveNext
- Set xlc = xlc.Offset(1, 0)
- Loop
- End If
- rst.Close
- Set rst = Nothing
- dbs.Close
- Set dbs = Nothing
- ' Close the EXCEL file while saving the file, and clean up the EXCEL objects
- Set xlc = Nothing
- Set xlsx = Nothing
- xlw.Close True ' close the EXCEL file and save the new data
- Set xlw = Nothing
- If blnEXCEL = True Then xlx.Quit
- Set xlx = Nothing
- End Function