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