I've been able to piece together code that will take the access query and export it to a new excel file and save it appropriately to the correct location with the correct file name. (Many references to this site and getting additional ideas) This works great for one query to one tab in an excel document. I'm now trying to modify what I have done and call two different queries and publish them to different worksheets in an excel template.
I am getting a Run-Time error '9': Subscript out of range message. When I go to debug this line of code : [vba]Set objSheet = objBook.Worksheets("Detail")[/vba]is the breaking point. when I'm only trying to publish one query no problems. Any help would be appreciated!
Here is all of the code:
[vba]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
sCriteria = " 1 = 1 "
If COID <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Detail (NE)].COID = """ & COID & """"
End If
If Activity_Date <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Detail (NE)].Activity_Date like """ & Activity_Date & "*"""
End If
If Dept_ID <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Detail (NE)].Dept_ID = """ & Dept_ID & """"
End If
If "Dept Desc" <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Detail (NE)].[Dept Desc] = """ & "Dept Desc" & """"
End If
If Error_Cd <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Detail (NE)].Error_Cd = """ & Error_Cd & """"
End If
If Room_Code <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Detail (NE)].Room_Code = """ & Room_Code & """"
End If
If Err_Description <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Detail (NE)].Err_Description = """ & Err_Description & """"
End If
If VIP <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Detail (NE)].VIP = """ & VIP & """"
End If
If PT_NUM <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Detail (NE)].PT_NUM = """ & PT_NUM & """"
End If
If Svc_Date <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Detail (NE)].SVC_Date = """ & Svc_Date & """"
End If
If CDM <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Detail (NE)].CDM = """ & CDM & """"
End If
If CDM_DESC <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Detail (NE)].CDM_DESC = """ & CDM_DESC & """"
End If
If CDM_CHRG <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Detail (NE)].CDM_CHRG = """ & CDM_CHRG & """"
End If
'If StartDate <> "" And EndDate <> "" Then
' sCriteria = sCriteria & " AND qryTransferDataToExcel.DateOfPaper between #" & Format(StartDate, "dd-mmm-yyyy") _
' & "# and #" & Format(EndDate, "dd-mmm-yyyy") & "#"
'End If
Set db = CurrentDb()
'This is new
strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\NE_eYMH055 (2010-02-23).xlt" ' template file reference
sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\NE_eYMH055" & " (" & 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("Detail")
objBook.Windows(1).Visible = True
'Opens the recordset and sets the variable
Set rst = db.OpenRecordset("10q_Daily_eKMH221_Enhanced_Detail (NE)")
With objSheet
.Select
'Clears the current contents in the workbook range
.Range("A2:K65000").ClearContents
'rst Copies the recordset into the worksheet
.Range("A2").CopyFromRecordset rst
End With
If COID <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Summary (NE)].COID = """ & COID & """"
End If
If Activity_Date <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Summary (NE)].Activity_Date like """ & Activity_Date & "*"""
End If
If Dept_ID <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Summary (NE)].Dept_ID = """ & Dept_ID & """"
End If
If "Dept Desc" <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Summary (NE)].[Dept Desc] = """ & "Dept Desc" & """"
End If
If Error_Cd <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Summary (NE)].Error_Cd = """ & Error_Cd & """"
End If
If Room_Code <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Summary (NE)].Room_Code = """ & Room_Code & """"
End If
If Err_Description <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Summary (NE)].Err_Description = """ & Err_Description & """"
End If
If CDM_CT <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Summary (NE)].CDM_CT = """ & CDM_CT & """"
End If
If CDM_CHRG <> "" Then
sCriteria = sCriteria & " AND [10q_Daily_eKMH221_Enhanced_Summary (NE)].CDM_CHRG = """ & CDM_CHRG & """"
End If
Set objSheet = objBook.Worksheets("Summary")
objBook.Windows(1).Visible = True
'Opens the recordset and sets the variable
Set rst = db.OpenRecordset("10q_Daily_eKMH221_Enhanced_Summary (NE)")
With objSheet
.Select
'Clears the current contents in the workbook range
.Range("A7:H792").ClearContents
'rst Copies the recordset into the worksheet
.Range("A7").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 KMH221 has been published"
End Sub[/vba]
Again Thank you in advance for any guidance/suggestions
Reply With Quote
Originally Posted by OBP
