Gasman
Enthusiastic Amateur
- Local time
- Today, 09:26
- Joined
- Sep 21, 2011
- Messages
- 16,202
Hi all,
I am trying to export query data to an Excel workbook and sheet.
I have the following code created by a respected member of the MS community. Copied and amended for my situation.
It was late binding as you can see, but I changed it to early just to see if that was the issue.
I have MS Excel 16 in my references.
I get the error when trying to open the workbook which does exist in that path.
I have tried the app with New as well as without.
So what am I missing please.?
ApXL is created and visible in Locals on both syntax.
IM window
strTQname: qryMonthlyCalc
strSheetName: qryMonthlyCalc
strPath: F:\Users\Paul\Documents\Diabetes.xlsx
I am trying to export query data to an Excel workbook and sheet.
I have the following code created by a respected member of the MS community. Copied and amended for my situation.
It was late binding as you can see, but I changed it to early just to see if that was the issue.
I have MS Excel 16 in my references.
I get the error when trying to open the workbook which does exist in that path.
I have tried the app with New as well as without.
So what am I missing please.?
ApXL is created and visible in Locals on both syntax.
Code:
Function SendToExcel(strTQName As String, strSheetName As String, strPath As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
' strPath is full path and name of Excel workbook
'Dim ApXL As Object, xlWBk As Object, xlWSh As Object
Dim ApXL As Excel.Application
Dim xlWBk As Excel.Workbook
Dim xlWsh As Excel.Worksheet
Dim rs As DAO.Recordset
On Error GoTo Err_Handler
Debug.Print "strTQname: " & strTQName
Debug.Print "strSheetName: " & strSheetName
Debug.Print "strPath: " & strPath
Set rs = CurrentDb.OpenRecordset(strTQName)
Set ApXL = New Excel.Application
Set xlWBk = ApXL.Workbooks.Open(strPath)
ApXL.Visible = True
Set xlWsh = xlWBk.Worksheets(strSheetName)
rs.MoveFirst
xlWsh.Range("A2").CopyFromRecordset rs
'Selects the first cell to unselect all cells
xlWsh.Range("A2").Select
xlWsh.Activate
xlWsh.Cells.Rows(4).AutoFilter
xlWsh.Cells.Rows(4).EntireColumn.AutoFit
rs.Close
Set rs = Nothing
'Remove prompts to save the report
ApXL.DisplayAlerts = False
xlWBk.Save 'As "Put the path where you want the file saved OR change to just save your existing file", 51
ApXL.DisplayAlerts = True
Exit Function
Err_Handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Exit Function
End Function
IM window
strTQname: qryMonthlyCalc
strSheetName: qryMonthlyCalc
strPath: F:\Users\Paul\Documents\Diabetes.xlsx