Help exporting parameter query to excel

jzwp22 said:
Since the only parameter is the posting date, the rest of the criteria that prompted for parameters was not necessary. I did not test the Excel part of the code; I only made sure that you had a valid query being supplied to the open recordset command. The modified DB is attached.
Click to expand...


Thank you I will take a look at it in the morning. I've already left work for the day! Again I cannot say enough THANK YOU!
 
You're welcome; let us know if you have additional questions once you have taken a look at the code.
 
jzwp22 said:
You're welcome; let us know if you have additional questions once you have taken a look at the code.
Click to expand...
Thank you!!!!!!

Everything works perfectly!

I actually answered the question I was going to ask before I posted it.
I wanted to automatically have it save the file as filename ([post_date]+1).xls trying different variations I was able to accomplish this!
I am posting the completed updated code

THANK YOU AGAIN FOR EVERYTHING!

PHP: 
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()
'construct the SELECT and FROM clauses of the query
    mySQL = "SELECT [10t_KMH310_Data].COID, ([Post_Date]+1) AS Rpt_Date, [10t_KMH310_Data].Dept_ID AS DEPT, "
    mySQL = mySQL & " [10t_KMH310_Data].Dept_Description AS DEPT_NAME, [10t_KMH310_Data].Pt_Name, [10t_KMH310_Data].Pt_Num AS PT_ACCT, "
    mySQL = mySQL & " [10t_KMH310_Data].CDM, [10t_KMH310_Data].CDM_Description AS CDM_DESC, [10t_KMH310_Data].Post_Date, "
    mySQL = mySQL & " [10t_KMH310_Data].Trans_Date, [10t_KMH310_Data].Qty, [10t_KMH310_Data].PT, [10t_KMH310_Data].RVU, "
    mySQL = mySQL & " [10t_KMH310_Data].Amount, [10t_KMH310_Data].Batch "
    mySQL = mySQL & " FROM [10t_KMH310_Data]"
    
    
    
    'construct the WHERE Clause
 
    If Nz(Me.Post_Date, "") = "" Then
        MsgBox "You must enter a post date"
        Me.Post_Date.SetFocus
        Exit Sub
    Else
        sCriteria = sCriteria & " [10t_KMH310_Data].POST_DATE = #" & Me.Post_Date & "#"
    End If
   
'add the WHERE Clause to the mySQL variable
mySQL = mySQL & " WHERE" & sCriteria
Debug.Print mySQL

'proceed with opening the recordset
   
    
  Set rst = db.OpenRecordset(mySQL)
    '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([Post_Date] + 1, "yyyy-mm-dd") & ").xls" 'output file name and path set up to automatically save the file with the POST_Date +1
    
    
   
    
    '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
    
    'Set rst = db.OpenRecordset("10q_Daily_eKMH310_Charge_Data (NE)")
        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
 
Ok, One more question!!!

The sample works perfectly!

I eliminated 3 of the COID's in what was posted.

the original query that this was referencing only pulled COID "NE"
when I posted this code into my db it is working correctly except that it is pulling ALL COID's into this file

I plan on creating a button that the user can click to publish each COIDs Report.

The COID's are HH, NE, SE, and TR


How can i modify the sql statement to only pull in NE data?

Thank you again so much for your help!


jd.willis said:
Thank you!!!!!!

Everything works perfectly!

I actually answered the question I was going to ask before I posted it.
I wanted to automatically have it save the file as filename ([post_date]+1).xls trying different variations I was able to accomplish this!
I am posting the completed updated code

THANK YOU AGAIN FOR EVERYTHING!

PHP: 
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()
'construct the SELECT and FROM clauses of the query
    mySQL = "SELECT [10t_KMH310_Data].COID, ([Post_Date]+1) AS Rpt_Date, [10t_KMH310_Data].Dept_ID AS DEPT, "
    mySQL = mySQL & " [10t_KMH310_Data].Dept_Description AS DEPT_NAME, [10t_KMH310_Data].Pt_Name, [10t_KMH310_Data].Pt_Num AS PT_ACCT, "
    mySQL = mySQL & " [10t_KMH310_Data].CDM, [10t_KMH310_Data].CDM_Description AS CDM_DESC, [10t_KMH310_Data].Post_Date, "
    mySQL = mySQL & " [10t_KMH310_Data].Trans_Date, [10t_KMH310_Data].Qty, [10t_KMH310_Data].PT, [10t_KMH310_Data].RVU, "
    mySQL = mySQL & " [10t_KMH310_Data].Amount, [10t_KMH310_Data].Batch "
    mySQL = mySQL & " FROM [10t_KMH310_Data]"
 
 
 
    'construct the WHERE Clause
 
    If Nz(Me.Post_Date, "") = "" Then
        MsgBox "You must enter a post date"
        Me.Post_Date.SetFocus
        Exit Sub
    Else
        sCriteria = sCriteria & " [10t_KMH310_Data].POST_DATE = #" & Me.Post_Date & "#"
    End If
 
'add the WHERE Clause to the mySQL variable
mySQL = mySQL & " WHERE" & sCriteria
Debug.Print mySQL
 
'proceed with opening the recordset
 
 
  Set rst = db.OpenRecordset(mySQL)
    '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([Post_Date] + 1, "yyyy-mm-dd") & ").xls" 'output file name and path set up to automatically save the file with the POST_Date +1
 
 
 
 
    '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
 
    'Set rst = db.OpenRecordset("10q_Daily_eKMH310_Charge_Data (NE)")
        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
Click to expand...
 
If all of the data for each COID is in the 10t_KMH310_Data table, you can just add another criteria for the user to enter on your form & add another IF..THEN to the code to add the criteria to the query that is built in the code I would probably add a combo box control to your form that lists the various COID's that way if you add others in the future it will show up without have to change the code. It will also relieve your users from having to remember all of the various COID's. You can base the combo box on a query SELECT DISTINCT COID FROM 10t_KMH310_Data if you don't have the COID's in a separate table.
 
All of the COID's are in the same table. I wanted to set it up because each COID is published to its own report.

Ie. NE_eKMH310 Daily Charges.xls
SE_eKMH310 Daily Charges.xls etc.

Currently the code is set up to autosave the file as NE_ekh310.....xls


If I add a combo box to select the COID wouldnt each file still be saved as the NE_ekMh310....xls file?

Thank you again!
 
Just adjust your output filename with the COID inputted by the user. You'll have to adjust the msgbox text accordingly as well.

Code: 
 sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\" [COLOR="Red"]& me.coidcomboboxname & "_[/COLOR]eKMH310" & " (" & Format([Post_Date] + 1, "yyyy-mm-dd") & ").xls"
 
I've attached the sample database modified with a combo box for the COID
 

Attachments

Thank you Soo much for your help with this!!!!!!!!! Works great!:):):):):):):):)
 
Thank you again for your help.

Now what I'm trying to do is specify the template to use and the save to location. I have added the if then statements for each COID and now i'm getting a compile error.
Block If without End if.

the break point is on End Sub

I really appreciate all of your help with this!

PHP: 
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
    Dim sfname As String
     Set db = CurrentDb()
'construct the SELECT and FROM clauses of the query
    mySQL = "SELECT [10t_KMH310_Data].COID, ([Post_Date]+1) AS Rpt_Date, [10t_KMH310_Data].Dept_ID AS DEPT, "
    mySQL = mySQL & " [10t_KMH310_Data].Dept_Description AS DEPT_NAME, [10t_KMH310_Data].Pt_Name, [10t_KMH310_Data].Pt_Num AS PT_ACCT, "
    mySQL = mySQL & " [10t_KMH310_Data].CDM, [10t_KMH310_Data].CDM_Description AS CDM_DESC, [10t_KMH310_Data].Post_Date, "
    mySQL = mySQL & " [10t_KMH310_Data].Trans_Date, [10t_KMH310_Data].Qty, [10t_KMH310_Data].PT, [10t_KMH310_Data].RVU, "
    mySQL = mySQL & " [10t_KMH310_Data].Amount, [10t_KMH310_Data].Batch "
    mySQL = mySQL & " FROM [10t_KMH310_Data]"
    
    
    
    'construct the WHERE Clause
 
    If Nz(Me.Post_Date, "") = "" Then
        MsgBox "You must enter a post date"
        Me.Post_Date.SetFocus
        Exit Sub
    Else
        sCriteria = sCriteria & " [10t_KMH310_Data].POST_DATE = #" & Me.Post_Date & "#"
    End If
   
    If Nz(Me.cboCOID, "") = "" Then
        MsgBox "You must select a COID from the list"
        Me.cboCOID.SetFocus
        Exit Sub
    Else
        sCriteria = sCriteria & " AND [10t_KMH310_Data].COID = '" & Me.cboCOID & "'"
        
    End If
   
'add the WHERE Clause to the mySQL variable
mySQL = mySQL & " WHERE" & sCriteria
Debug.Print mySQL

'proceed with opening the recordset
   
    
  Set rst = db.OpenRecordset(mySQL)
    'This is new
    
    If Me.cboCOID = "NE" Then
    
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\NE_EKMH310 (2010-02-23).xlt" ' template file reference
    
    Else
    
    If Me.cboCOID = "SE" Then
    
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\SE_EKMH310 (2010-02-23).xlt" ' template file reference
        
    Else
    
    If Me.cboCOID = "HH" Then
    
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\TMC_EKMH310_HH (2010-02-22).xlt" ' template file reference
    
    sfname = "TMC_eKMH310_" & "Me.cboCOID" & " (" & Format([Post_Date] + 1, "yyyy-mm-dd") & ").xls"
    
    Else
    
    If Me.cboCOID = "TR" Then
    
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\TMC_EKMH310_TR (2010-02-23).xlt" ' template file reference
        
    sfname = "TMC_eKMH310_" & "Me.cboCOID" & " (" & Format([Post_Date] + 1, "yyyy-mm-dd") & ").xls"
    
    End If
    
    
    If Me.cboCOID = "NE" Then
    
    sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\NE\" & sfname 'output file name and path
    
    Else
    
    If Me.cboCOID = "SE" Then
    
   sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\SE\" & sfname 'output file name and path
   
   Else
   
   If Me.cboCOID = "HH" Then
   
   sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\TMC\" & sfname 'output file name and path
   
   Else
   
   If Me.cboCOID = "TR" Then
   
   sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\TR\" & sfname 'output file name and path
    
   End If
   
    
    '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
    
    'Set rst = db.OpenRecordset("10q_Daily_eKMH310_Charge_Data (NE)")
        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 Me.cboCOID & " eKMH310 has been published"
    
End Sub
 
You are probably missing an END IF statement. For every IF you need an END IF otherwise the code will fail. I also see that you are repeating the same IF statment (red versus blue below). You might be better off using the SELECT CASE ... END SELECT rather than IF..THEN ESLE.. END IF

If Me.cboCOID = "NE" Then

strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\NE_EKMH310 (2010-02-23).xlt" ' template file reference

Else

If Me.cboCOID = "SE" Then

strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\SE_EKMH310 (2010-02-23).xlt" ' template file reference

Else

If Me.cboCOID = "HH" Then

strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\TMC_EKMH310_HH (2010-02-22).xlt" ' template file reference

sfname = "TMC_eKMH310_" & "Me.cboCOID" & " (" & Format([Post_Date] + 1, "yyyy-mm-dd") & ").xls"

Else

If Me.cboCOID = "TR" Then

strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\TMC_EKMH310_TR (2010-02-23).xlt" ' template file reference

sfname = "TMC_eKMH310_" & "Me.cboCOID" & " (" & Format([Post_Date] + 1, "yyyy-mm-dd") & ").xls"

End If

If Me.cboCOID = "NE" Then

sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\NE\" & sfname 'output file name and path

Else

If Me.cboCOID = "SE" Then

sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\SE\" & sfname 'output file name and path

Else

If Me.cboCOID = "HH" Then

sOutput = "W:HERHER - Patient Access ManagementPasCoordProcess Improvement TeamJasonRevopsTMC" & sfname 'output file name and path

Else

If Me.cboCOID = "TR" Then

sOutput = "W:HERHER - Patient Access ManagementPasCoordProcess Improvement TeamJasonRevopsTR" & sfname 'output file name and path

End If
 
Ok, I'm still trying to understand,
However I changed the code as such:
by combining the if then statements
as below.
Not sure if this is correct or not, but i'm still getting the BLOCK if without End if error.

PHP: 
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
    Dim sfname As String
    
    Set db = CurrentDb()
    
'construct the SELECT and FROM clauses of the query
    mySQL = "SELECT [10t_KMH310_Data].COID, ([Post_Date]+1) AS Rpt_Date, [10t_KMH310_Data].Dept_ID AS DEPT, "
    mySQL = mySQL & " [10t_KMH310_Data].Dept_Description AS DEPT_NAME, [10t_KMH310_Data].Pt_Name, [10t_KMH310_Data].Pt_Num AS PT_ACCT, "
    mySQL = mySQL & " [10t_KMH310_Data].CDM, [10t_KMH310_Data].CDM_Description AS CDM_DESC, [10t_KMH310_Data].Post_Date, "
    mySQL = mySQL & " [10t_KMH310_Data].Trans_Date, [10t_KMH310_Data].Qty, [10t_KMH310_Data].PT, [10t_KMH310_Data].RVU, "
    mySQL = mySQL & " [10t_KMH310_Data].Amount, [10t_KMH310_Data].Batch "
    mySQL = mySQL & " FROM [10t_KMH310_Data]"
    
    
    
    'construct the WHERE Clause
 
    If Nz(Me.Post_Date, "") = "" Then
        MsgBox "You must enter a post date"
        Me.Post_Date.SetFocus
        Exit Sub
    Else
        sCriteria = sCriteria & " [10t_KMH310_Data].POST_DATE = #" & Me.Post_Date & "#"
    End If
   
    If Nz(Me.cboCOID, "") = "" Then
        MsgBox "You must select a COID from the list"
        Me.cboCOID.SetFocus
        Exit Sub
    Else
        sCriteria = sCriteria & " AND [10t_KMH310_Data].COID = '" & Me.cboCOID & "'"
        
    End If
   
'add the WHERE Clause to the mySQL variable
mySQL = mySQL & " WHERE" & sCriteria
Debug.Print mySQL

'proceed with opening the recordset
   
    
  Set rst = db.OpenRecordset(mySQL)
    'This is new
    
    If Me.cboCOID = "NE" Then
    
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\NE_EKMH310 (2010-02-23).xlt" ' template file reference
    
    sfname = Me.cboCOID & "_eKMH310" & " (" & Format(Date, "yyyy-mm-dd") & ").xls"
    
    sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\NE\" & sfname 'output file name and path
    
    Else
    
    If Me.cboCOID = "SE" Then
    
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\SE_EKMH310 (2010-02-23).xlt" ' template file reference
    
    sfname = Me.cboCOID & "_eKMH310" & " (" & Format(Date, "yyyy-mm-dd") & ").xls"
    
    sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\SE\" & sfname 'output file name and path
    
    Else
    
    If Me.cboCOID = "HH" Then
    
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\TMC_EKMH310_HH (2010-02-22).xlt" ' template file reference
    
    sfname = "TMC_eKMH310_" & "Me.cboCOID" & " (" & Format([Post_Date] + 1, "yyyy-mm-dd") & ").xls"
    
    sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\TMC\" & sfname 'output file name and path
    
    Else
    
    If Me.cboCOID = "TR" Then
    
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\TMC_EKMH310_TR (2010-02-23).xlt" ' template file reference
        
    sfname = "TMC_eKMH310_" & "Me.cboCOID" & " (" & Format([Post_Date] + 1, "yyyy-mm-dd") & ").xls"
    
    sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\TR\" & sfname 'output file name and path
    
    End If
   
    
    '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
    
    'Set rst = db.OpenRecordset("10q_Daily_eKMH310_Charge_Data (NE)")
        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 Me.cboCOID & " eKMH310 has been published"
    
End Sub
 
OK, I figured it out. I added the necessary END IF statements and its all working correctly!

Thank you again for your help
I'm posting the code for others to reference

AGAIN! THANK YOU!

PHP: 
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
    Dim sfname As String
    
    Set db = CurrentDb()
    
'construct the SELECT and FROM clauses of the query
    mySQL = "SELECT [10t_KMH310_Data].COID, ([Post_Date]+1) AS Rpt_Date, [10t_KMH310_Data].Dept_ID AS DEPT, "
    mySQL = mySQL & " [10t_KMH310_Data].Dept_Description AS DEPT_NAME, [10t_KMH310_Data].Pt_Name, [10t_KMH310_Data].Pt_Num AS PT_ACCT, "
    mySQL = mySQL & " [10t_KMH310_Data].CDM, [10t_KMH310_Data].CDM_Description AS CDM_DESC, [10t_KMH310_Data].Post_Date, "
    mySQL = mySQL & " [10t_KMH310_Data].Trans_Date, [10t_KMH310_Data].Qty, [10t_KMH310_Data].PT, [10t_KMH310_Data].RVU, "
    mySQL = mySQL & " [10t_KMH310_Data].Amount, [10t_KMH310_Data].Batch "
    mySQL = mySQL & " FROM [10t_KMH310_Data]"
    
    
    
    'construct the WHERE Clause
 
    If Nz(Me.Post_Date, "") = "" Then
        MsgBox "You must enter a post date"
        Me.Post_Date.SetFocus
        Exit Sub
    Else
        sCriteria = sCriteria & " [10t_KMH310_Data].POST_DATE = #" & Me.Post_Date & "#"
    End If
   
    If Nz(Me.cboCOID, "") = "" Then
        MsgBox "You must select a COID from the list"
        Me.cboCOID.SetFocus
        Exit Sub
    Else
        sCriteria = sCriteria & " AND [10t_KMH310_Data].COID = '" & Me.cboCOID & "'"
        
    End If
   
'add the WHERE Clause to the mySQL variable
mySQL = mySQL & " WHERE" & sCriteria
Debug.Print mySQL

'proceed with opening the recordset
   
    
  Set rst = db.OpenRecordset(mySQL)
    'This is new
    
    If Me.cboCOID = "NE" Then
    
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\NE_EKMH310 (2010-02-23).xlt" ' template file reference
    
    sfname = Me.cboCOID & "_eKMH310" & " (" & Format([Post_Date] + 1, "yyyy-mm-dd") & ").xls"
    
    sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\NE\" & sfname 'output file name and path
    Else
    
    End If
    
 
    
    If Me.cboCOID = "SE" Then
    
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\SE_EKMH310 (2010-02-23).xlt" ' template file reference
    
    sfname = Me.cboCOID & "_eKMH310" & " (" & Format([Post_Date] + 1, "yyyy-mm-dd") & ").xls"
    
    sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\SE\" & sfname 'output file name and path
    
    Else
    End If
    
    
    
    If Me.cboCOID = "HH" Then
    
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\TMC_EKMH310_HH (2010-02-22).xlt" ' template file reference
    
    sfname = "TMC_eKMH310_" & "Me.cboCOID" & " (" & Format([Post_Date] + 1, "yyyy-mm-dd") & ").xls"
    
    sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\TMC\" & sfname 'output file name and path
    Else
    End If
    
    
    
    If Me.cboCOID = "TR" Then
    
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\TMC_EKMH310_TR (2010-02-23).xlt" ' template file reference
        
    sfname = "TMC_eKMH310_" & "Me.cboCOID" & " (" & Format([Post_Date] + 1, "yyyy-mm-dd") & ").xls"
    
    sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\TR\" & sfname 'output file name and path
    
    End If
   
    
    '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
    
    'Set rst = db.OpenRecordset("10q_Daily_eKMH310_Charge_Data (NE)")
        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 Me.cboCOID & " eKMH310 has been published"
    
End Sub
 
Glad you got it work out. The SELECT CASE... END SELECT looks a little cleaner but will function the same as the IF..THEN.. ELSE.. END IF's. It would be as follows:

Code: 
Select Case Me.cboCOID
Case Is = "NE"
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\NE_EKMH310 (2010-02-23).xlt" ' template file reference
    sfname = Me.cboCOID & "_eKMH310" & " (" & Format(Date, "yyyy-mm-dd") & ").xls"
    sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\NE\" & sfname 'output file name and path
Case Is = "SE"
    strTemplatePath = "W:HERHER - AdministrationrevopsRevOps_DatabasesMonarchROSS_Uploads01 - DailyExcel TemplatesSE_EKMH310 (2010-02-23).xlt" ' template file reference
    sfname = Me.cboCOID & "_eKMH310" & " (" & Format(Date, "yyyy-mm-dd") & ").xls"
    sOutput = "W:HERHER - Patient Access ManagementPasCoordProcess Improvement TeamJasonRevopsSE" & sfname 'output file name and path
Case Is = "HH"
    strTemplatePath = "W:HERHER - AdministrationrevopsRevOps_DatabasesMonarchROSS_Uploads01 - DailyExcel TemplatesTMC_EKMH310_HH (2010-02-22).xlt" ' template file reference
    sfname = "TMC_eKMH310_" & "Me.cboCOID" & " (" & Format([Post_Date] + 1, "yyyy-mm-dd") & ").xls"
    sOutput = "W:HERHER - Patient Access ManagementPasCoordProcess Improvement TeamJasonRevopsTMC" & sfname 'output file name and path
Case Is = "TR"
    strTemplatePath = "W:HERHER - AdministrationrevopsRevOps_DatabasesMonarchROSS_Uploads01 - DailyExcel TemplatesTMC_EKMH310_TR (2010-02-23).xlt" ' template file reference
    sfname = "TMC_eKMH310_" & "Me.cboCOID" & " (" & Format([Post_Date] + 1, "yyyy-mm-dd") & ").xls"
    sOutput = "W:HERHER - Patient Access ManagementPasCoordProcess Improvement TeamJasonRevopsTR" & sfname 'output file name and path
End Select
 
You must log in or register to reply here.

Similar threads

zelarra821
Solved Export to Excel and leave the workbook open
Replies
5
Views
1,115
zelarra821
zelarra821
oxicottin
Solved Export search form data to excel
Replies
11
Views
1,364
oxicottin
oxicottin
F
Add query data to existing export function
Replies
1
Views
813
MarkK
MarkK
D
Export to Excel not working correctly
Replies
2
Views
1,260
arnelgp
arnelgp
F
Solved Add result from one function to another export function
Replies
18
Views
2,138
FoolzRailer
F

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom