Adding Tab, Copying Range to Excel via Access VBA

Experts. I have a program in Access that I'm using to dump a query to excel. Once it's in excel I want to add a second worksheet, name the worksheets, copy all data from the first worksheet to the second and sort the second sheet by a different column.

Below is the code I have so far. When I run the code, the spreadsheet opens and the name of the first tab changes and then it ignores the rest of the code - no error. If I close the spreadsheet while still in access and run the code again, it works perfectly.  Any ideas?!

>>>>>>

Dim stDocName As String
stDocName = "qryExceptionsbyProgram"
DoCmd.OutputTo acOutputQuery, stDocName, acFormatXLS, " " & stDocName & ".xls", True


'copy the contents of the first tab to a second added tab
Dim ExcelObject As Excel.Application
   
On Error Resume Next
    ' if excel is already open it uses that instance
    Set ExcelObject = GetObject(, "Excel.Application")

    ' if excel isn't open, it opens a new instance of excel
    If ExcelObject Is Nothing Then
        Set ExcelObject = New Excel.Application
        ExcelObject.EnableEvents = False
    End If

ExcelObject.Application.Sheets("qryExceptionsbyProgram").Select
ExcelObject.Application.ActiveSheet.Name = "Sorted by Property Name"
ExcelObject.Application.Sheets.Add After:=ActiveSheet
ExcelObject.Application.ActiveSheet.Name = "Sorted by Program Type"
ExcelObject.Application.Sheets("Sorted by Property Name").Range("a:e").Copy
ExcelObject.Application.Range("a1").Select
ExcelObject.Application.ActiveSheet.Paste

'Apply sorting to the second tab
ExcelObject.Application.Columns("A:E").Sort key1:=Range("C2"), _
      order1:=xlAscending, Header:=xlYes

ExcelObject.Application.ActiveSheet.Name = "Sorted by Property Name"

>>>>>>>
acramer_dominiumAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Jeffrey CoachmanMIS LiasonCommented:
very wild guess..
Add a line:

    DoEvents
....after the line that names the sheet...
0
acramer_dominiumAuthor Commented:
Tried that and it behaved the same way. I've attached an example database with all my objects in it. There is one form with two different buttons. The buttons are doing the same routine just with different data.

When you click a button, spreadsheet pops up not complete. Close spreadsheet. Click button again, spreadsheet pops up complete.
ExcelExample.mdb
0
acramer_dominiumAuthor Commented:
Figured it out!! Before I export the query to excel I open a new instance of excel. Then after I export to excel I set my object to the instance of excel that's open. It works every time!!

>>>>>>

Private Sub cmdExcProgram_Click()
    Dim cn As ADODB.Connection
    Dim sSQL As String
 
'Turn off message boxes
DoCmd.SetWarnings False

Dim ExcelObject As excel.Application
Set ExcelObject = New excel.Application

'Delete all records from the temp program type table

Set cn = CurrentProject.Connection
     
sSQL = "Delete * FROM tblTempProgramType"

cn.Execute sSQL
Set cn = Nothing

'Append the program types to the temp table
DoCmd.OpenQuery "qryAppendExceptionPrograms"

'Update all IGL yes's to the temp table
DoCmd.OpenQuery "qryUpdateExceptionIGL"

'Update all RL yes's to the temp table
DoCmd.OpenQuery "qryUpdateExceptionRL"

'Update all IGL na's to the temp table
DoCmd.OpenQuery "qryUpdateExceptionIGLNA"

'Update all RL na's to the temp table
DoCmd.OpenQuery "qryUpdateExceptionRLNA"

'Update all IGL no's to the temp table
DoCmd.OpenQuery "qryUpdateExceptionIGLNo"

'Update all RL no's to the temp table
DoCmd.OpenQuery "qryUpdateExceptionRLNo"

Dim stDocName As String
stDocName = "qryExceptionsbyProgram"
DoCmd.OutputTo acOutputQuery, stDocName, acFormatXLS, " " & stDocName & ".xls", True

'copy the contents of the first tab to a second added tab
Set ExcelObject = GetObject(, "Excel.Application")

ExcelObject.Application.Sheets("qryExceptionsbyProgram").Select
ExcelObject.Application.ActiveSheet.Name = "Sorted by Property Name"
ExcelObject.Application.Sheets.Add After:=ActiveSheet
ExcelObject.Application.ActiveSheet.Name = "Sorted by Program Type"
ExcelObject.Application.Sheets("Sorted by Property Name").Range("a:f").Copy
ExcelObject.Application.Range("a1").Select
ExcelObject.Application.ActiveSheet.Paste

'Apply sorting to the second tab
ExcelObject.Application.Columns("A:F").Sort key1:=Range("D2"), _
      order1:=xlAscending, Header:=xlYes

ExcelObject.Application.Sheets("Sorted by Property Name").Activate

End Sub

>>>>>>
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Newly released Acronis True Image 2019

In announcing the release of the 15th Anniversary Edition of Acronis True Image 2019, the company revealed that its artificial intelligence-based anti-ransomware technology – stopped more than 200,000 ransomware attacks on 150,000 customers last year.

Jeffrey CoachmanMIS LiasonCommented:
Get rid of the DoEvents and add in a "Save"
This worked for me...


ExcelObject.Application.Sheets("qryExceptionsbyProgram").Select
ExcelObject.Application.ActiveSheet.Name = "Sorted by Property Name"
ExcelObject.Application.Sheets.Add After:=ActiveSheet
ExcelObject.Application.ActiveSheet.Name = "Sorted by Program Type"

ExcelObject.ActiveWorkbook.Save

ExcelObject.Application.Sheets("Sorted by Property Name").Range("a:f").Copy
ExcelObject.Application.Range("a1").Select
ExcelObject.Application.ActiveSheet.Paste


JeffCoachman
0
Jeffrey CoachmanMIS LiasonCommented:
just for fun, try mu suggestion as well
0
acramer_dominiumAuthor Commented:
Works every time
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.