Solved: Export 2 Queries to 1 excel workbook [Archive]

View Full Version : Solved: Export 2 Queries to 1 excel workbook

jd.willis

05-27-2010, 05:44 AM

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 : Set objSheet = objBook.Worksheets("Detail")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:
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

Again Thank you in advance for any guidance/suggestions

OBP

05-27-2010, 07:09 AM

You could try using the value of the Details Sheet in the Sheets collection, ie.
= Wkb.Sheets(1)

jd.willis

05-27-2010, 07:31 AM

Thank you for your help with this. I'm new working with vb where would i place this in my code?

OBP

05-27-2010, 10:18 AM

Where you currently have
Set objSheet = objBook.Worksheets("Detail")

It would become
Set objSheet = objBook.Worksheets(1)
or whatever number sheet Detail is in the list
Has the Detail sheet actually been created at this stage?

Bob Phillips

05-27-2010, 11:59 AM

Or you could name the sheet

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
objBook.Worksheets(1).Name = "Detail"
Set objSheet = objBook.Worksheets("Detail")
objBook.Windows(1).Visible = True
'Opens the recordset and sets the variable

Bob Phillips

05-27-2010, 12:01 PM

jd.willis

05-27-2010, 02:42 PM

I realized I had a typo in my orinal code: I have corrected it and it is working perfectly. I was also referencing an incorrect template file which i have also updated.

Thanks again for all of the help!

Corrected Code:
Private Sub NE_KMH221_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

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

Set db = CurrentDb()
'This is new
strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\NE_eKMH221 (2010-02-23).xlt" ' template file reference
sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\NE_eKMH221" & " (" & 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