The vba code takes ages to display the result

[aman]

I have two backing databases which are linked to one Access frontend.In both backing databases, there is 1 table in each. One table has 2105075 records and another one has 488,014 records. So when I try to run the following code then the query takes long time to execute.

Can anybody please help me speed it up.

Private Sub Command4_Click()
 
strsql = "select [Date GoneAway Received],username,count(*) from tblmain where not username is null group by [Date GoneAway Received],username union select [Date GoneAway Received],username,count(*) from tbldata where not username is null group by [Date GoneAway Received],username"
 
If DCount("Name", "MSysobjects", "Name='qrytemp' and type=5") > 0 Then
DoCmd.DeleteObject acQuery, "qrytemp"
End If
Set qdf = CurrentDb.CreateQueryDef("qrytemp", strsql)
    Dim objXls As Excel.Application
    Dim objWrkBk As Excel.Workbook
    Dim xprtFile As String
 
  xprtFile = "J:\time1.xls"
 
    DoCmd.OutputTo acOutputQuery, "qrytemp", acFormatXLS, xprtFile, False
    Set objXls = New Excel.Application
    objXls.Visible = True
 
    Set objWrkBk = objXls.Workbooks.Open(xprtFile)
    objWrkBk.Sheets("qrytemp").Select
    With objWrkBk.Sheets("qrytemp")
              .Application.Rows("1:1").Select
        .Application.Selection.Font.Bold = True
        .Application.Selection.Columns.AutoFit
    End With
 
    With objWrkBk.Sheets("qrytemp").PageSetup
           .Orientation = xlLandscape
             .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
 
Set qdf = Nothing
End Sub

 

[thechazm]

The only thing I can see here and the way you are trying to fetch the data is to have two hidden forms open up before you execute this code that would already open the database connection for both backends thus reducing the amount of time it takes for this query to execute.

 

[vbaInet]

Change your transfer method from OutputTo to TransferSpreadsheet.