Whats wrong with my code? (Export query to Excel) (1 Viewer)

QuietRiot

Registered User.
Local time
Today, 15:40
Joined
Oct 13, 2007
Messages
71
I can only run it once and it works fine. Then i have to close the database and open it again. If i run it once close the excel sheet then clear the values on my form and run it again it doesn't work.

Code:
Private Sub ReconReport()
    Dim dbs As DAO.Database
    Dim rstGetExportData As Recordset
    Dim rs As DAO.Recordset
    Dim objXL As Object
    Dim objCreateWkb As Object
    Dim objActiveWkb As Object
    Dim X As Long, Y As Long, FieldCount As Long
    Set dbs = CurrentDb
    Set objXL = CreateObject("Excel.Application")
    Set objCreateWkb = objXL.Workbooks.Add
    Set objActiveWkb = objXL.Application.ActiveWorkbook
    objXL.Visible = True

    On Error GoTo ErrClean
    
    
'---------- Name sheets
    objActiveWkb.Sheets.Add
    objActiveWkb.Sheets("Sheet1").Name = "Matches"
    objActiveWkb.Sheets("Sheet2").Name = "AMT Mismatch"
    objActiveWkb.Sheets("Sheet3").Name = "Not on ITA"
    objActiveWkb.Sheets("Sheet4").Name = "Not on PHX"
    
    
'-------------- Matches query
    
    Set rstGetExportData = dbs.OpenRecordset("Matches")
    objActiveWkb.Sheets("Matches").Select
    
        With objActiveWkb.ActiveSheet
            .Cells(2, 1).CopyFromRecordset rstGetExportData
        End With
            
    FieldCount = rstGetExportData.Fields.Count
    objActiveWkb.ActiveSheet.Range("A1").Select
    
   For X = 0 To FieldCount - 1
       With objXL
         .ActiveCell = rstGetExportData.Fields(X).Name
         .ActiveCell.Offset(0, 1).Select
       End With
   Next
    
        With objActiveWkb.ActiveSheet
            .Rows("1:1").Font.Bold = True
            .Columns.AutoFit
            Range("A1:G1").Select
            Range("G1").Activate
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            Range("A1").Select
        End With
   
   
'-------------- AMT non Match query
    
    Set rstGetExportData = dbs.OpenRecordset("AMTnonMatch")
    objActiveWkb.Sheets("AMT Mismatch").Select
    
        With objActiveWkb.ActiveSheet
            .Cells(2, 1).CopyFromRecordset rstGetExportData
        End With
            
    FieldCount = rstGetExportData.Fields.Count
    objActiveWkb.ActiveSheet.Range("A1").Select
    
   For X = 0 To FieldCount - 1
       With objXL
         .ActiveCell = rstGetExportData.Fields(X).Name
         .ActiveCell.Offset(0, 1).Select
       End With
   Next
    
        With objActiveWkb.ActiveSheet
            .Rows("1:1").Font.Bold = True
            .Columns.AutoFit
            Columns("H:H").Select
            Selection.Font.ColorIndex = 3
            Columns("H:H").Select
            Selection.Font.Bold = False
            Selection.Font.Bold = True
            Range("A1:H1").Select
            Range("H1").Activate
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            Range("A1").Select
        End With
   
   '-------------- Not on ITA query
    
    Set rstGetExportData = dbs.OpenRecordset("NotOnITA")
    objActiveWkb.Sheets("Not On ITA").Select
    
        With objActiveWkb.ActiveSheet
            .Cells(2, 1).CopyFromRecordset rstGetExportData
        End With
            
    FieldCount = rstGetExportData.Fields.Count
    objActiveWkb.ActiveSheet.Range("A1").Select
    
   For X = 0 To FieldCount - 1
       With objXL
         .ActiveCell = rstGetExportData.Fields(X).Name
         .ActiveCell.Offset(0, 1).Select
       End With
   Next
    
        With objActiveWkb.ActiveSheet
            .Rows("1:1").Font.Bold = True
            .Columns.AutoFit
            Range("A1:D1").Select
            Range("D1").Activate
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            Range("A1").Select
        End With
   
   '-------------- Not on PHX query
    
    Set rstGetExportData = dbs.OpenRecordset("NotOnPHX")
    objActiveWkb.Sheets("Not On PHX").Select
    
        With objActiveWkb.ActiveSheet
            .Cells(2, 1).CopyFromRecordset rstGetExportData
        End With
            
    FieldCount = rstGetExportData.Fields.Count
    objActiveWkb.ActiveSheet.Range("A1").Select
    
   For X = 0 To FieldCount - 1
       With objXL
         .ActiveCell = rstGetExportData.Fields(X).Name
         .ActiveCell.Offset(0, 1).Select
       End With
   Next
    
        With objActiveWkb.ActiveSheet
            .Rows("1:1").Font.Bold = True
            .Columns.AutoFit
            Range("A1:C1").Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        Range("A1").Select
    End With
        
   objActiveWkb.Sheets("Matches").Select
 
ErrClean:
'show excel and clean
    Set objActiveWkb = Nothing
    Set objCreateWkb = Nothing
    Set objXL = Nothing
    rstGetExportData.Close
    dbs.Close
    Set rstGetExportData = Nothing
    Set dbs = Nothing
    DoCmd.SetWarnings True
End Sub
 

QuietRiot

Registered User.
Local time
Today, 15:40
Joined
Oct 13, 2007
Messages
71
Forgot to mention the error message.. 1004 - Method 'Range' of object'_global failed

but it doesn't show me in my code.
 

Kafrin

Database Designer
Local time
Today, 23:40
Joined
Feb 17, 2009
Messages
149
Not sure if it will work, but try getting rid of the line "dbs.Close" at the end. You don't want to close dbs as it's the current database, you just want to empty the variable, which you do with the line "Set dbs = Nothing".
 

Dennisk

AWF VIP
Local time
Today, 23:40
Joined
Jul 22, 2004
Messages
1,649
I think you need to close your recordset prior to setting it again(except the first instance)
 

LPurvis

AWF VIP
Local time
Today, 23:40
Joined
Jun 16, 2008
Messages
1,269
While it's a better practice to close a recordset before re-opening it, it's not required.

Your issue is an old one though.
While you've been adopting the correct practice of maintaining the required automation object variables - you've not quite been dilligent enough in catching all references to Excel objects.
The first example I spotted with a cursory glance was:
Range("A1:G1").Select
which should, of course, be
objXL.Range("A1:G1").Select

Check for others too.
The reason automation fails like this is an unqualified object such as this is created implicitly. The chances are that this first creation hits the intended target (by chance).
Subsequent calls and VBA hasn't released the implicit object and it isn't recreated for you. It fails.
Full qualifcation will sort your issue.

Cheers.
 

Users who are viewing this thread

Top Bottom