Hi all. I have some code (below) that is slowly being built to take data from a number of query recordsets and moves them into a specific excel workbook (each data set gets its own newly created sheet) and then will (eventually once I figure it all out) create a reconciliation report on the data.
My problem is that when I open access and go to my code and hit F5 it generally does what I want it to (still trying to get it to only make worksheets in excel when there is data in the query recordset and still can't get the field names to appear in any of the worksheets) but once it has exited the sub, if I hit F5 again it opens that correct excel file, but it does not do anything else it is supposed to do.
Here is the code...any ideas?
****************(BTW I was thinking that it was creating more than one instance of excel. Not sure and if it is how would I get it to stop doing that...the excel file must be open at the end of the code so the user can look for and resolve variances in the reconciliation)**********************
My problem is that when I open access and go to my code and hit F5 it generally does what I want it to (still trying to get it to only make worksheets in excel when there is data in the query recordset and still can't get the field names to appear in any of the worksheets) but once it has exited the sub, if I hit F5 again it opens that correct excel file, but it does not do anything else it is supposed to do.
Here is the code...any ideas?
****************(BTW I was thinking that it was creating more than one instance of excel. Not sure and if it is how would I get it to stop doing that...the excel file must be open at the end of the code so the user can look for and resolve variances in the reconciliation)**********************
Code:
Option Explicit
Public oXWBcode As Object
Public db As DAO.Database
Public rstF, rstQ, rstT As DAO.Recordset
Public qrydf, qrydfOLD As DAO.QueryDef
Public strANNUAL, strMONTHc, strMONTHf, strANNUALfy, strSQL, strQRYname, _
strTBLname, strSQLold, strTBLfdname, strXwbcodepath As String
Public LTBLct, icols As Long
Public fld As DAO.Field
Public Sub AuRDMonth()
On Error GoTo ErrCapture
Dim strMONTH As String
Dim i As Variant
Dim intRST As Integer
Dim strdbFP As String
Dim oEXCEL, oXWB, oXWS, oXWScode, oXWSqry, oXrng As Object
Dim bXO As Boolean
Dim Lrow, Lcol As Long
Set db = CurrentDb
With db
'DoCmd.OpenForm "RPT_DCAS_AuRD_REC"
strANNUAL = "2015"
strANNUALfy = "FY" & Right(strANNUAL, 2)
strMONTH = "December"
'strANNUAL = Forms![rpt_dcas_aurd_rec]![TXTannual]
'strANNUALfy = "FY" & Right(strANNUAL, 2)
'strMONTH = Forms![rpt_dcas_aurd_rec]![CMboMonth].Column(1)
Select Case strMONTH
Case "October"
strMONTHc = "10"
strMONTHf = "01"
strANNUAL = strANNUAL - 1
Case "November"
strMONTHc = "11"
strMONTHf = "02"
strANNUAL = strANNUAL - 1
Case "December"
strMONTHc = "12"
strMONTHf = "03"
strANNUAL = strANNUAL - 1
Case "January"
strMONTHc = "01"
strMONTHf = "04"
Case "February"
strMONTHc = "02"
strMONTHf = "05"
Case "March"
strMONTHc = "03"
strMONTHf = "06"
Case "April"
strMONTHc = "04"
strMONTHf = "07"
Case "May"
strMONTHc = "05"
strMONTHf = "08"
Case "June"
strMONTHc = "06"
strMONTHf = "09"
Case "July"
strMONTHc = "07"
strMONTHf = "10"
Case "August"
strMONTHc = "08"
strMONTHf = "11"
Case "September"
strMONTHc = "09"
strMONTHf = "12"
End Select
strdbFP = CurrentProject.Path & "\"
'Start Excel
On Error Resume Next
Set oEXCEL = CreateObject("Excel.Application") 'Bind to existing instance of Excel
Set oXWBcode = oEXCEL.Workbooks.Open("G:\Financial Reconciliations\DB Code file\Code for DB recs.xlsm")
strXwbcodepath = oXWBcode.Path & "\" & oXWBcode.Name
'Debug.Print strXwbcodepath
If Err.Number <> 0 Then 'Could not get instance of Excel, so create a new one
Err.Clear
On Error GoTo ErrCapture
Set oEXCEL = CreateObject("Excel.Application")
bXO = False
Else 'Excel was already running
bXO = True
End If
oEXCEL.ScreenUpdating = False
oEXCEL.Visible = True
Set oXWScode = oXWBcode.Sheets(1)
With oXWScode
Cells(1, 1).Value = "Monthly"
Cells(2, 1).Value = strANNUAL
Cells(3, 1).Value = strMONTH
Cells(4, 1).Value = strdbFP
End With
strSQL = "SELECT * FROM TBL_Systems"
Set rstF = db.OpenRecordset(strSQL, dbOpenSnapshot)
If (rstF.BOF And rstF.EOF) Then
MsgBox "No records in Systems Table"
GoTo errEXIT
End If
Do While Not rstF.EOF
strTBLname = "TBL_" & rstF.system.Value
strSQL = "SELECT * FROM TBL_" & rstF.Fields("System") _
& " WHERE AddFieldFileDate = '" _
& strANNUAL & strMONTHc & "'"
strSQLold = "SELECT * FROM TBL_" & rstF.Fields("System")
strQRYname = "QRY_" & rstF.system.Value
db.QueryDefs(strQRYname).SQL = strSQL
Set rstQ = db.OpenRecordset(strQRYname)
If Not rstQ.Recordset > 0 Then
With oXWBcode
Set oXWSqry = oXWBcode.Worksheets.Add(after:= _
Worksheets(Worksheets.Count))
oXWSqry.Name = rstF.Fields("System") & " Detail"
End With
End If
'i = 1
With rstQ
If .RecordCount <> 0 Then
For icols = 0 To rstQ.Fields.Count - 1
'oXWBcode.oXWSqry.Cells(1, icols + 1).Value _
= i
oXWBcode.oXWSqry.Cells(1, icols + 1).Value _
= rstQ.Fields(icols).Name
'i = i + 1
Next
oXWBcode.oXWSqry.Range("A2").CopyFromRecordset rstQ
oXWBcode.oXWSqry.Range(oXWSqry.Cells(1, 1), oXWSqry.Cells _
(1, rstQ.Fields.Count)).Columns.AutoFit
oXWBcode.oXWSqry.Range("A1").Select
End If
End With
db.QueryDefs(strQRYname).SQL = strSQLold
rstF.MoveNext
Loop
MsgBox "done"
End With
errEXIT:
On Error Resume Next
oEXCEL.Visible = True 'Make excel visible to the user
Set oXWSqry = Nothing
Set oXWBcode = Nothing
oEXCEL.ScreenUpdating = True
Set oEXCEL = Nothing
rstF.Close
rstQ.Close
db.Close
Set db = Nothing
Set rstF = Nothing
Set rstQ = Nothing
Exit Sub
ErrCapture:
MsgBox "MS Access has generated the following error" & vbCrLf _
& vbCrLf & "Error Number: " & Err.Number & vbCrLf _
& "Error Source: CreateQry" & vbCrLf & "Error Description: " & _
Err.Description, vbCritical, "An Error has Occured!"
Resume errEXIT
End Sub