jd.willis
06-07-2010, 06:03 AM
:help
I'm trying to automate exporting a parameter query to excel using code. I am using similar code to export a regular query without the parameter and it works great. Now I am getting a Runtime 5 error. What can I do to correct this? Below is the code and below that is the line where debugging starts with the error.
Thanks for any and all help!
I would also like to set this up to where the file is saved as the parameter date +1 just not sure how to do that.
Thanks again!
Private Sub NEKMH310_Click()
On Error Resume Next
Dim sCriteria As String
Dim db As Database
Dim rst As Recordset
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim strTemplatePath As String
Dim sOutput As String
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Set db = CurrentDb()
Set qdf = db.QueryDefs("10q_Daily_eKMH310_Charge_Data (NE)")
qdf![forms!10f_kmh310_publish!post_date] = [Forms]![10f_kmh310_publish]![Post_Date]
sCriteria = " 1 = 1 "
If COID <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].COID = """ & COID & """"
End If
If RPT_DATE <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].RPT_DATE like """ & RPT_DATE & """"
End If
If DEPT <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].DEPT = """ & DEPT & """"
End If
If DEPT_Name <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].DEPT_NAME = """ & DEPT_Name & """"
End If
If PT_NAME <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].PT_Name = """ & PT_NAME & """"
End If
If PAT_ACCT <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].PAT_acct = """ & PAT_ACCT & """"
End If
If CDM <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].CDM = """ & CDM & """"
End If
If CDM_DESC <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].CDM_DESC = """ & CDM_DESC & """"
End If
If Post_Date <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].POST_DATE = """ & Post_Date & """"
End If
If TRANS_DATE <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].TRANS_DATE = """ & TRANS_DATE & """"
End If
If QTY <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].QTY = """ & QTY & """"
End If
If PT <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].PT = """ & PT & """"
End If
If RVU <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].RVU = """ & RVU & """"
End If
If AMOUNT <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].AMOUNT = """ & AMOUNT & """"
End If
If BATCH <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].BATCH = """ & BATCH & """"
End If
'This is new
strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\NE_EKMH310 (2010-02-23).xlt" ' template file reference
sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\NE_eKMH310" & " (" & Format(Date, "yyyy-mm-dd") & ").xls" 'output file name and path
'This is new
Set objApp = New Excel.Application
'This is new 'Your excel spreadsheet file goes here
Set objBook = objApp.Workbooks.Add(strTemplatePath)
'Name of sheet you want to export to
Set objApp = objBook.Parent
Set objSheet = objBook.Worksheets("KMH310")
objBook.Windows(1).Visible = True
'Opens the recordset and sets the variable
With objSheet
.Select
'Clears the current contents in the workbook range
.Range("A9:O65000").ClearContents
'rst Copies the recordset into the worksheet
.Range("A9").CopyFromRecordset rst
End With
objBook.SaveAs (sOutput)
objBook.Close
rst.Close
objApp.Visible = False
Set rst = Nothing
Set db = Nothing
Set objSheet = Nothing
Set objBook = Nothing
Set objApp = Nothing
MsgBox "NE eKMH310 has been published"
End Sub
Breaking point
.Range("A9").CopyFromRecordset rst
I'm trying to automate exporting a parameter query to excel using code. I am using similar code to export a regular query without the parameter and it works great. Now I am getting a Runtime 5 error. What can I do to correct this? Below is the code and below that is the line where debugging starts with the error.
Thanks for any and all help!
I would also like to set this up to where the file is saved as the parameter date +1 just not sure how to do that.
Thanks again!
Private Sub NEKMH310_Click()
On Error Resume Next
Dim sCriteria As String
Dim db As Database
Dim rst As Recordset
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim strTemplatePath As String
Dim sOutput As String
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Set db = CurrentDb()
Set qdf = db.QueryDefs("10q_Daily_eKMH310_Charge_Data (NE)")
qdf![forms!10f_kmh310_publish!post_date] = [Forms]![10f_kmh310_publish]![Post_Date]
sCriteria = " 1 = 1 "
If COID <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].COID = """ & COID & """"
End If
If RPT_DATE <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].RPT_DATE like """ & RPT_DATE & """"
End If
If DEPT <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].DEPT = """ & DEPT & """"
End If
If DEPT_Name <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].DEPT_NAME = """ & DEPT_Name & """"
End If
If PT_NAME <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].PT_Name = """ & PT_NAME & """"
End If
If PAT_ACCT <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].PAT_acct = """ & PAT_ACCT & """"
End If
If CDM <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].CDM = """ & CDM & """"
End If
If CDM_DESC <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].CDM_DESC = """ & CDM_DESC & """"
End If
If Post_Date <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].POST_DATE = """ & Post_Date & """"
End If
If TRANS_DATE <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].TRANS_DATE = """ & TRANS_DATE & """"
End If
If QTY <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].QTY = """ & QTY & """"
End If
If PT <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].PT = """ & PT & """"
End If
If RVU <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].RVU = """ & RVU & """"
End If
If AMOUNT <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].AMOUNT = """ & AMOUNT & """"
End If
If BATCH <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH310_Charge_Data (NE)].BATCH = """ & BATCH & """"
End If
'This is new
strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\NE_EKMH310 (2010-02-23).xlt" ' template file reference
sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\NE_eKMH310" & " (" & Format(Date, "yyyy-mm-dd") & ").xls" 'output file name and path
'This is new
Set objApp = New Excel.Application
'This is new 'Your excel spreadsheet file goes here
Set objBook = objApp.Workbooks.Add(strTemplatePath)
'Name of sheet you want to export to
Set objApp = objBook.Parent
Set objSheet = objBook.Worksheets("KMH310")
objBook.Windows(1).Visible = True
'Opens the recordset and sets the variable
With objSheet
.Select
'Clears the current contents in the workbook range
.Range("A9:O65000").ClearContents
'rst Copies the recordset into the worksheet
.Range("A9").CopyFromRecordset rst
End With
objBook.SaveAs (sOutput)
objBook.Close
rst.Close
objApp.Visible = False
Set rst = Nothing
Set db = Nothing
Set objSheet = Nothing
Set objBook = Nothing
Set objApp = Nothing
MsgBox "NE eKMH310 has been published"
End Sub
Breaking point
.Range("A9").CopyFromRecordset rst