Reserved error (-7713): There is no message for this error

K

Kheribus

Registered User.
Local time
Today, 00:31
Joined
Mar 30, 2015
Messages
97
Hello all,

I have an access project that uses linked tables to MySQL Database. Using MySQL ODBC 5.1 driver (64 bit).

I have a sub that copies recordset data to newly created excel files. It was working just fine and then randomly stopped working.

I get the following error when attempting to simply recordset.movenext

Reserved Error (-7713) There is no message for this error.

I've troubleshooted this a bit.. tried to relink my tables based off of some light googling. Before I link any code or go any deeper, has anyone seen this error message?

This may have something to do with having an open excel instance... or, i just am at a loss here.
 
I should add that the recordset i'm attempting to .movenext doesnt' even have anything to do with the data i'm copying to the file. It's simply a recordset that I use to iterate through contracts ... basically a value I use to determine which file the recordset will be copied to (multiple vendors).
 
Kheribus said:
..
Reserved Error (-7713) There is no message for this error.

I've troubleshooted this a bit.. tried to relink my tables based off of some light googling. Before I link any code or go any deeper, has anyone seen this error message?
Click to expand...
Seems a lot of people have seen it, Google: Reserved Error (-7713) a lot of hints pops up.
Kheribus said:
..
I have a sub that copies recordset data to newly created excel files. It was working just fine and then randomly stopped working.
Click to expand...
If it is more or less each second time then check the object references (Excel) in your code.
Show your code.
 
Thanks for the reply. I used to get an automation bug (sorry can't remember the message) every other time, which did have something to do with how i was calling/handling the Excel object. However that randomly went away and it just stopped working all together. The 7713 googling i've done either says to relink tables, which i've tried, or has directions for fixing a specific type of proprietary odbc connection type that i'm not using.

This sub creates the files:

Code: 
Public Sub createFiles()

Dim invoicing As DAO.Database, rstContract As DAO.Recordset, rstContractz As DAO.Recordset, rstName As DAO.Recordset, fileName As String, contractorName() As String, invoiceNum As String
Dim startDate() As String, endDate As String
Set invoicing = CurrentDb

Set rstContractz = invoicing.OpenRecordset("SELECT contractorID from contractor where contractorName NOT LIKE 'All'")

Do While Not rstContractz.EOF

    Set rstName = invoicing.OpenRecordset("SELECT contractorName FROM contractor where contractorID = " & rstContractz!contractorID)
    contractorName = split(rstName!contractorName, " ")
    startDate = split([Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate], "/")
    If startDate(1) = "1" Or startDate(1) = "01" Then
        invoiceNum = "1"
    Else
        invoiceNum = "2"
    End If
    
    fileName = "C:\Users\Administrator\Desktop\Final Invoices\20160" & startDate(0) & Right(startDate(2), 2) & invoiceNum & "_" & contractorName(0) & ".xlsx"
    
    If Dir(fileName) = "" Then
        Workbooks.Add
        Rows("1:1").Select
        Selection.Font.Bold = True
        Cells.Select
        Selection.Columns.AutoFit
        If Worksheets.count < 2 Then
            ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.count)
            Rows("1:1").Select
            Selection.Font.Bold = True
            Cells.Select
            Selection.Columns.AutoFit
        End If
        If Worksheets.count < 3 Then
            ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.count)
            Rows("1:1").Select
            Selection.Font.Bold = True
            Cells.Select
            Selection.Columns.AutoFit
        End If
        ActiveWorkbook.SaveAs (fileName)
        Debug.Print fileName + " created!"
        ActiveWorkbook.Close
    End If
rstContractz.MoveNext
Loop
End Sub

That one seems to work fine. There are two things happening in the below code.

1: 4 lines up from the bottom of the code, I am getting the 7713 error when trying to move to the next rstContract record with rstContract.movenext.

2: I have to comment out the Sheet 2 and Sheet 3 sections because program hangs on this line:

Code: 
.Worksheets("Sheet2").Range("A" & CStr(lngLastDataRow + 1)).CopyFromRecordset rstMidday

Here's the code where the issues are happening:

Code: 
Private Sub Command484_Click()

Dim invoicing As DAO.Database, rstContract As DAO.Recordset, rstContracts As DAO.Recordset, strSQL As String, rstName As DAO.Recordset, contractorName() As String, appExcel As Object, contractor As String
Dim lngLastDataRow As Long, fileName As String, RS2 As DAO.Recordset, qfd As DAO.QueryDef, outputFile As Workbook, wkb As Workbook, startDate() As String, invoiceNum As String
Dim oServ As Object, cProc As Variant, oProc As Object, rstMidday As DAO.Recordset, rstModifications As DAO.Recordset, intColIndex As Integer, filePath As String, coNo As String
Dim qdfSummary As DAO.QueryDef, sqltext As String, errReturnCode As String
Set invoicing = CurrentDb

contractor = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![contractor].Value

If contractor = "" Then
    MsgBox ("Please select a contractor!")
Else
    If contractor = "All" Then
        Set rstContract = invoicing.OpenRecordset("SELECT contractorID from contractor WHERE contractorName NOT LIKE 'All'")
    Else
        Set rstContract = invoicing.OpenRecordset("SELECT contractorID from contractor where contractorName = '" & contractor & "'")
    End If
End If

Do While Not rstContract.EOF

    Set rstContracts = invoicing.OpenRecordset("SELECT * FROM contracts WHERE contractorID = " & rstContract!contractorID)
    rstContracts.MoveFirst
    
    createFiles
    
    Do While Not rstContracts.EOF
   
        coNo = rstContracts!coNo
        
        'Set rstContract = invoicing.OpenRecordset("SELECT coNo FROM contracts where coNo = '" & rstContracts!coNo & "'")
        'define the query to define our report
            
         'to create querydef for excel reports
         strSQL = "SELECT invoicesummary.tripName, invoicesummary.coNo, invoicesummary.busType, invoicesummary.startDate, invoicesummary.endDate, invoicesummary.numDays, invoicesummary.numAids,  invoicesummary.dlyServiceTime, " & _
          "invoicesummary.dlyaidtime, invoicesummary.baserate, invoicesummary.baseTotal, invoicesummary.aidbaserate, invoicesummary.aidbasetotal, invoicesummary.aidincrementrate, invoicesummary.aidincrementtotal, invoicesummary.incrementalrate, invoicesummary.incrementaltotal, " & _
         "invoicesummary.aidTotal As 'aidTotal', invoicesummary.supplementalrate, invoicesummary.supplementalTotal, invoicesummary.fuelCostReimb, " & _
         "invoicesummary.balance FROM (contractor INNER JOIN contracts ON contractor.contractorID = contracts.contractorID) INNER JOIN invoicesummary ON contracts.coNo = invoicesummary.coNo " & _
         " WHERE (((invoicesummary.startDate) >= [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate]) And ((invoicesummary.endDate) <= " & _
         "[Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate]) And ((invoicesummary.coNo) = '" & rstContracts!coNo & _
         "'))ORDER BY invoicesummary.tripName, invoicesummary.endDate;"
            
         'to create querydef for invoice summary pdf report
         sqltext = "SELECT invoicesummary.tripName, invoicesummary.startDate, invoicesummary.endDate, invoicesummary.numDays, invoicesummary.numAids, invoicesummary.busType, invoicesummary.dlyServiceTime, invoicesummary.baseTotal, invoicesummary.aidTotal, invoicesummary.incrementalTotal, invoicesummary.supplementalTotal, invoicesummary.fuelCostReimb, invoicesummary.balance, invoicesummary.dlyaidtime, invoicesummary.baserate, invoicesummary.aidbaserate, invoicesummary.aidbasetotal, invoicesummary.aidincrementrate, invoicesummary.aidincrementtotal, invoicesummary.incrementalrate, invoicesummary.incrementaltotal, invoicesummary.supplementalrate FROM (contractor INNER JOIN contracts ON contractor.contractorID = contracts.contractorID) INNER JOIN invoicesummary ON contracts.coNo = invoicesummary.coNo " & _
         "WHERE (((invoicesummary.startDate) >= [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate]) And ((invoicesummary.endDate) <= [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate]) And ((invoicesummary.coNo) = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![coNo])) " & _
         "ORDER BY invoicesummary.tripName, invoicesummary.endDate;"
    
        'create querydef to pass our query to the acexport command
        
        'determine contractor name to name Excel output and filename to export
        Set rstName = invoicing.OpenRecordset("SELECT contractorName FROM contractor where contractorID = " & rstContracts!contractorID)
        contractorName = split(rstName!contractorName, " ")
        startDate = split([Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate], "/")
        If startDate(1) = "1" Or startDate(1) = "01" Then
            invoiceNum = "1"
        Else
            invoiceNum = "2"
        End If
        
        fileName = "C:\Users\Administrator\Desktop\Final Invoices\20160" & startDate(0) & Right(startDate(2), 2) & invoiceNum & "_" & contractorName(0) & ".xlsx"
        Debug.Print "Exporting contract " & coNo & " to " & fileName
        
        If Dir(fileName) = "" Then
            Workbooks.Add
            ActiveWorkbook.SaveAs (fileName)
        End If
        
        'delete the querydef's if they exist so we dont get an error (for instance, if the code didnt execute all the way through last time it was run)
        For Each qfd In invoicing.QueryDefs
            If qfd.Name = "tempQuery" Then
                invoicing.QueryDefs.Delete "tempQuery"
                Exit For
            End If
        Next
                 
        For Each qfd In invoicing.QueryDefs
            If qfd.Name = "invoiceSummaryAutomation Query" Then
                invoicing.QueryDefs.Delete "invoiceSummaryAutomation Query"
                Exit For
            End If
        Next
        
        Set appExcel = CreateObject("Excel.Application")
        invoicing.CreateQueryDef "tempQuery", strSQL
        'Set RS2 = invoicing.OpenRecordset("tempQuery")
        Set qfd = invoicing.QueryDefs("tempQuery")
        qfd.Parameters("[Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate]").Value = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate]
        qfd.Parameters("[Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate]").Value = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate]
        
        Set qdfSummary = invoicing.CreateQueryDef("invoiceSummaryAutomation Query", sqltext)
        
        'grab our invoice summary query (pertaining to current cono into query
        Set RS2 = qfd.OpenRecordset(Type:=dbOpenDynaset)
        'grab midday information to recordset for sheet 2 of excel report
        Set rstMidday = invoicing.OpenRecordset("SELECT tripName, description, dateInfo, busType, lastUpdate FROM tripslog WHERE coNo = '" & rstContracts!coNo & "' AND midday = 1 and tripName NOT LIKE '_E%'")
       
        'grab modification information relevant to this contract for sheet 3 of excel report
        Set rstModifications = invoicing.OpenRecordset("SELECT * FROM modifications WHERE modDate >= #" & [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate] & "# AND modDate <= #" & [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate] & "# AND coNo = '" & rstContracts!coNo & "'")
        
        RS2.MoveFirst
        With appExcel
          .Visible = False
          .UserControl = True
          .DisplayAlerts = False
        
           With .Workbooks.Open(fileName)
                
                'create field names for SHEET 1 (Invoice Summary)
                For intColIndex = 0 To RS2.Fields.count - 1
                   .Worksheets("Sheet1").Range("A1").Offset(0, intColIndex).Value = RS2.Fields(intColIndex).Name
                Next
                
                'append recordset data to SHEET 1
                lngLastDataRow = .Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
                .Worksheets("Sheet1").Range("A" & CStr(lngLastDataRow + 1)).CopyFromRecordset RS2
                
                'create field names for SHEET 2 (Midday Trip Report)
                If rstMidday.RecordCount > 0 Then
                    For intColIndex = 0 To rstMidday.Fields.count - 1
                       .Worksheets("Sheet2").Range("A1").Offset(0, intColIndex).Value = rstMidday.Fields(intColIndex).Name
                    Next
                    'append recordset data to SHEET 2
                    lngLastDataRow = .Worksheets("Sheet2").Cells.SpecialCells(xlCellTypeLastCell).Row
                   .Worksheets("Sheet2").Range("A" & CStr(lngLastDataRow + 1)).CopyFromRecordset rstMidday
                   .Worksheets("Sheet2").Range("E2", "E1000").NumberFormat = "mm/dd/yy"
                End If

                'create field names for SHEET 3 (Modification Report)
                If rstModifications.RecordCount > 0 Then
                    For intColIndex = 0 To rstModifications.Fields.count - 1
                       .Worksheets("Sheet3").Range("A1").Offset(0, intColIndex).Value = rstModifications.Fields(intColIndex).Name
                    Next
                    'append recordset data to SHEET 3
                    lngLastDataRow = .Worksheets("Sheet3").Cells.SpecialCells(xlCellTypeLastCell).Row
                    .Worksheets("Sheet3").Range("A" & CStr(lngLastDataRow + 1)).CopyFromRecordset rstModifications
                End If
                .Worksheets("Sheet1").Range("D2", "D1000").NumberFormat = "mm/dd/yy"
                .Worksheets("Sheet1").Range("E2", "E1000").NumberFormat = "mm/dd/yy"
                .Worksheets("Sheet1").Activate
                .Save
                .Close
                End With
        End With
        
        qdfSummary.Parameters("[Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate]").Value = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate]
        qdfSummary.Parameters("[Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate]").Value = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate]
        qdfSummary.Parameters("[Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![coNo]").Value = coNo
                        
        RS2.Close
        Set RS2 = Nothing
        Set appExcel = Nothing
        rstMidday.Close
        invoicing.QueryDefs.Delete "tempQuery"
        invoicing.QueryDefs.Delete "invoiceSummaryAutomation Query"
        rstContracts.MoveNext
    Loop
    'appExcel.WindowState = xlMaximized
    rstContract.MoveNext
Loop
Workbooks.Close

End Sub

So i'm creating the files, creating querydef's using form data to create a query and load it into a recordset to put into an excel file. If the contractor number relating to the recordset data is the same, then it will append that data to the end of the same contractor's excel file that relates to that contractor.
 
Last edited:
??? Perhaps it's bad memory on my part, but wasn't the ability to update linked excel files from Access removed???
 
These files aren't linked. I just create them with the creatfiles() sub and then open them and append to them with the main onclick sub.
 
I wonder that the code would run in first place!
In the sub "Public Sub createFiles" you haven't even declared and set a object to Excel.
And you also have a lot of code lines that are missing the reference to an Excel object, below I'll show some sample.
Code: 
   Workbooks.Add
   Rows("1:1").Select
   Selection.Font.Bold = True
   Cells.Select
   Selection.Columns.AutoFit
For getting that to run in MS-Access, you need the references to an Excel object in front of each line.
Code: 
   [B][COLOR=Red]AnExcelObject.[/COLOR][/B]Workbooks.Add
   [B][COLOR=Red]AnExcelObject.[/COLOR][/B]Rows("1:1").Select
   [B][COLOR=Red]AnExcelObject.[/COLOR][/B]Selection.Font.Bold = True
   [B][COLOR=Red]AnExcelObject.[/COLOR][/B]Cells.Select
   [B][COLOR=Red]AnExcelObject.[/COLOR][/B]Selection.Columns.AutoFit
In the sub "Private Sub Command484_Click" you've declared an set an Excel object, but you set it far down in the code and code lines before that need the references to an Excel object like here:
Code: 
If Dir(FileName) = "" Then
   Workbooks.Add
   ActiveWorkbook.SaveAs (FileName)
End If
Then you've a code line which hangs:
Code: 
.Worksheets("Sheet2").Range("A" & CStr(lngLastDataRow + 1)).CopyFromRecordset rstMidday
Again you're missing the reference to Excel, then lngLastDataRow is unknown to MS-Access:
Code: 
.Worksheets("Sheet2").Range("A" & CStr([B][COLOR=Red]AnExcelObject.[/COLOR][/B]lngLastDataRow + 1)).CopyFromRecordset rstMidday
I recommend you a use Option Explicit in each code module then you'll namely get namely to know if you use variables / constants which are not Declared/unknown in/for MS-Access.
So go through all your code, declare and set the Excel object, and put the references in front of each code line where you've something which is acting with Excel.
 
Last edited:
Thank you very much for the help. I actually do have option explicit set, so I'm not quite sure why I didn't get any debugging errors.

You're totally right... the createfiles sub works but I never even create an excel object. It's very curious how it ever worked at all.

Thanks again!
 
Last edited:
Well, I actually was referencing the Excel objects and the workbook objects because I was using With spans, but I went ahead and cleaned up the code to be how you are advising/expecting so that I may be able to get some help on this.

Still having the same problems listed above after modifying the code as you have suggested. Also, now when I open the first file in Excel and go to sheet 1, the first recordset data isn't copying to sheet 1, as before it used to before I changed the code below.

Create Files:

Code: 
Public Sub createFiles()

Dim invoicing As DAO.Database, rstContract As DAO.Recordset, rstContractz As DAO.Recordset, rstName As DAO.Recordset, fileName As String, contractorName() As String, invoiceNum As String
Dim startDate() As String, endDate As String
Set invoicing = CurrentDb
Dim ExcelObj As Excel.Application

Set ExcelObj = CreateObject("Excel.Application")

Set rstContractz = invoicing.OpenRecordset("SELECT contractorID from contractor where contractorName NOT LIKE 'All'")

Do While Not rstContractz.EOF

    Set rstName = invoicing.OpenRecordset("SELECT contractorName FROM contractor where contractorID = " & rstContractz!contractorID)
    contractorName = split(rstName!contractorName, " ")
    startDate = split([Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate], "/")
    If startDate(1) = "1" Or startDate(1) = "01" Then
        invoiceNum = "1"
    Else
        invoiceNum = "2"
    End If
    
    fileName = "C:\Users\Administrator\Desktop\Final Invoices\20160" & startDate(0) & Right(startDate(2), 2) & invoiceNum & "_" & contractorName(0) & ".xlsx"
    
    If Dir(fileName) = "" Then
        ExcelObj.Workbooks.Add
        ExcelObj.Rows("1:1").Select
        ExcelObj.Selection.Font.Bold = True
        ExcelObj.Cells.Select
        ExcelObj.Selection.Columns.AutoFit
        If ExcelObj.Worksheets.count < 2 Then
            ExcelObj.ActiveWorkbook.Sheets.Add After:=ExcelObj.Worksheets(ExcelObj.Worksheets.count)
            ExcelObj.Rows("1:1").Select
            ExcelObj.Selection.Font.Bold = True
            ExcelObj.Cells.Select
            ExcelObj.Selection.Columns.AutoFit
        End If
        If ExcelObj.Worksheets.count < 3 Then
            ExcelObj.ActiveWorkbook.Sheets.Add After:=ExcelObj.Worksheets(ExcelObj.Worksheets.count)
            ExcelObj.Rows("1:1").Select
            ExcelObj.Selection.Font.Bold = True
            ExcelObj.Cells.Select
            ExcelObj.Selection.Columns.AutoFit
        End If
        ExcelObj.ActiveWorkbook.SaveAs (fileName)
        Debug.Print fileName + " created!"
        ExcelObj.ActiveWorkbook.Close
    End If

rstContractz.MoveNext
Loop

End Sub

Main Code (where errors are happening):

Code: 
Private Sub Command484_Click()

Dim invoicing As DAO.Database, rstContract As DAO.Recordset, rstContracts As DAO.Recordset, strSQL As String, rstName As DAO.Recordset, contractorName() As String, appExcel As Object, contractor As String
Dim lngLastDataRow As Long, fileName As String, RS2 As DAO.Recordset, qfd As DAO.QueryDef, outputFile As Workbook, wkb As Workbook, startDate() As String, invoiceNum As String
Dim oServ As Object, cProc As Variant, oProc As Object, rstMidday As DAO.Recordset, rstModifications As DAO.Recordset, intColIndex As Integer, filePath As String, coNo As String
Dim qdfSummary As DAO.QueryDef, sqltext As String, errReturnCode As String

Set invoicing = CurrentDb

Dim ExcelObj As Excel.Application, wb As Excel.Workbook
Set ExcelObj = New Excel.Application

contractor = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![contractor].Value

If contractor = "" Then
    MsgBox ("Please select a contractor!")
Else
    If contractor = "All" Then
        Set rstContract = invoicing.OpenRecordset("SELECT contractorID from contractor WHERE contractorName NOT LIKE 'All'")
    Else
        Set rstContract = invoicing.OpenRecordset("SELECT contractorID from contractor where contractorName = '" & contractor & "'")
    End If
End If

Do While Not rstContract.EOF

    Set rstContracts = invoicing.OpenRecordset("SELECT * FROM contracts WHERE contractorID = " & rstContract!contractorID)
    
    rstContracts.MoveFirst
    
    createFiles
    
    Do While Not rstContracts.EOF
   
        coNo = rstContracts!coNo
        
        'to create querydef for excel reports
         strSQL = "SELECT invoicesummary.tripName, invoicesummary.coNo, invoicesummary.busType, invoicesummary.startDate, invoicesummary.endDate, invoicesummary.numDays, invoicesummary.numAids,  invoicesummary.dlyServiceTime, " & _
          "invoicesummary.dlyaidtime, invoicesummary.baserate, invoicesummary.baseTotal, invoicesummary.aidbaserate, invoicesummary.aidbasetotal, invoicesummary.aidincrementrate, invoicesummary.aidincrementtotal, invoicesummary.incrementalrate, invoicesummary.incrementaltotal, " & _
         "invoicesummary.aidTotal As 'aidTotal', invoicesummary.supplementalrate, invoicesummary.supplementalTotal, invoicesummary.fuelCostReimb, " & _
         "invoicesummary.balance FROM (contractor INNER JOIN contracts ON contractor.contractorID = contracts.contractorID) INNER JOIN invoicesummary ON contracts.coNo = invoicesummary.coNo " & _
         " WHERE (((invoicesummary.startDate) >= [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate]) And ((invoicesummary.endDate) <= " & _
         "[Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate]) And ((invoicesummary.coNo) = '" & rstContracts!coNo & _
         "'))ORDER BY invoicesummary.tripName, invoicesummary.endDate;"
            
        'to create querydef for invoice summary pdf report
        sqltext = "SELECT invoicesummary.tripName, invoicesummary.startDate, invoicesummary.endDate, invoicesummary.numDays, invoicesummary.numAids, invoicesummary.busType, invoicesummary.dlyServiceTime, invoicesummary.baseTotal, invoicesummary.aidTotal, invoicesummary.incrementalTotal, invoicesummary.supplementalTotal, invoicesummary.fuelCostReimb, invoicesummary.balance, invoicesummary.dlyaidtime, invoicesummary.baserate, invoicesummary.aidbaserate, invoicesummary.aidbasetotal, invoicesummary.aidincrementrate, invoicesummary.aidincrementtotal, invoicesummary.incrementalrate, invoicesummary.incrementaltotal, invoicesummary.supplementalrate FROM (contractor INNER JOIN contracts ON contractor.contractorID = contracts.contractorID) INNER JOIN invoicesummary ON contracts.coNo = invoicesummary.coNo " & _
        "WHERE (((invoicesummary.startDate) >= [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate]) And ((invoicesummary.endDate) <= [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate]) And ((invoicesummary.coNo) = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![coNo])) " & _
        "ORDER BY invoicesummary.tripName, invoicesummary.endDate;"
    
        'determine contractor name to name Excel output and filename to export
        Set rstName = invoicing.OpenRecordset("SELECT contractorName FROM contractor where contractorID = " & rstContracts!contractorID)
        contractorName = split(rstName!contractorName, " ")
        startDate = split([Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate], "/")
        If startDate(1) = "1" Or startDate(1) = "01" Then
            invoiceNum = "1"
        Else
            invoiceNum = "2"
        End If
        
        fileName = "C:\Users\Administrator\Desktop\Final Invoices\20160" & startDate(0) & Right(startDate(2), 2) & invoiceNum & "_" & contractorName(0) & ".xlsx"
        Debug.Print "Exporting contract " & coNo & " to " & fileName
        
        If Dir(fileName) = "" Then
            ExcelObj.Workbooks.Add
            ActiveWorkbook.SaveAs (fileName)
        End If
        
        'delete the querydef's if they exist so we dont get an error (for instance, if the code didnt execute all the way through last time it was run)
        For Each qfd In invoicing.QueryDefs
            If qfd.Name = "tempQuery" Then
                invoicing.QueryDefs.Delete "tempQuery"
                Exit For
            End If
        Next
                 
        For Each qfd In invoicing.QueryDefs
            If qfd.Name = "invoiceSummaryAutomation Query" Then
                invoicing.QueryDefs.Delete "invoiceSummaryAutomation Query"
                Exit For
            End If
        Next
        
        'create querydefs to define the data for our recordsets to put in the excel files
        invoicing.CreateQueryDef "tempQuery", strSQL
        Set qfd = invoicing.QueryDefs("tempQuery")
        qfd.Parameters("[Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate]").Value = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate]
        qfd.Parameters("[Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate]").Value = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate]
        
        Set qdfSummary = invoicing.CreateQueryDef("invoiceSummaryAutomation Query", sqltext)
        
        'grab our invoice summary query (pertaining to current cono into query
        Set RS2 = qfd.OpenRecordset(Type:=dbOpenDynaset)
        
        'grab midday information to recordset for sheet 2 of excel report
        Set rstMidday = invoicing.OpenRecordset("SELECT tripName, description, dateInfo, busType, lastUpdate FROM tripslog WHERE coNo = '" & rstContracts!coNo & "' AND midday = 1 and tripName NOT LIKE '_E%'")
       
        'grab modification information relevant to this contract for sheet 3 of excel report
        Set rstModifications = invoicing.OpenRecordset("SELECT * FROM modifications WHERE modDate >= #" & [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate] & "# AND modDate <= #" & [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate] & "# AND coNo = '" & rstContracts!coNo & "'")
        
        RS2.MoveFirst
                
        ExcelObj.Visible = False
        ExcelObj.UserControl = True
        ExcelObj.DisplayAlerts = False
        ExcelObj.Workbooks.Open (fileName)
                
        'create field names for SHEET 1 (Invoice Summary)
        For intColIndex = 0 To RS2.Fields.count - 1
          ExcelObj.Worksheets("Sheet1").Range("A1").Offset(0, intColIndex).Value = RS2.Fields(intColIndex).Name
        Next
          
        'append recordset data to SHEET 1
        lngLastDataRow = ExcelObj.Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
        ExcelObj.Worksheets("Sheet1").Range("A" & CStr(lngLastDataRow + 1)).CopyFromRecordset RS2
          
        'create field names for SHEET 2 (Midday Trip Report)
        If rstMidday.RecordCount > 0 Then
            For intColIndex = 0 To rstMidday.Fields.count - 1
                ExcelObj.Worksheets("Sheet2").Range("A1").Offset(0, intColIndex).Value = rstMidday.Fields(intColIndex).Name
            Next
            
            'append recordset data to SHEET 2
            lngLastDataRow = ExcelObj.Worksheets("Sheet2").Cells.SpecialCells(xlCellTypeLastCell).Row
            ExcelObj.Worksheets("Sheet2").Range("A" & CStr(lngLastDataRow + 1)).CopyFromRecordset rstMidday
            ExcelObj.Worksheets("Sheet2").Range("E2", "E1000").NumberFormat = "mm/dd/yy"
        End If

        'create field names for SHEET 3 (Modification Report)
        If rstModifications.RecordCount > 0 Then
            For intColIndex = 0 To rstModifications.Fields.count - 1
               ExcelObj.Worksheets("Sheet3").Range("A1").Offset(0, intColIndex).Value = rstModifications.Fields(intColIndex).Name
            Next
            'append recordset data to SHEET 3
            lngLastDataRow = ExcelObj.Worksheets("Sheet3").Cells.SpecialCells(xlCellTypeLastCell).Row
            ExcelObj.Worksheets("Sheet3").Range("A" & CStr(lngLastDataRow + 1)).CopyFromRecordset rstModifications
        End If
        
        ExcelObj.Worksheets("Sheet1").Range("D2", "D1000").NumberFormat = "mm/dd/yy"
        ExcelObj.Worksheets("Sheet1").Range("E2", "E1000").NumberFormat = "mm/dd/yy"
        ExcelObj.Worksheets("Sheet1").Activate

        ExcelObj.Workbooks.Close
        
        qdfSummary.Parameters("[Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate]").Value = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate]
        qdfSummary.Parameters("[Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate]").Value = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate]
        qdfSummary.Parameters("[Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![coNo]").Value = coNo
        
        'generate pdf invoice summary report (for signing)
        'fileName = Right(rstContracts!cono, 5) & "08162"
        'filePath = "C:\Users\Administrator\Desktop\Final Invoices\" & fileName & ".pdf"
        'DoCmd.OpenReport "Invoice Summary Automation", acViewReport, , [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![cono] = rstContracts!cono
        'Reports![Invoice Summary Automation]![Text111] = cono
        'DoCmd.OutputTo acOutputReport, "Invoice Summary Automation", acFormatPDF, filePath
                
        RS2.Close
        Set RS2 = Nothing
        Set ExcelObj = Nothing
        rstMidday.Close
        invoicing.QueryDefs.Delete "tempQuery"
        invoicing.QueryDefs.Delete "invoiceSummaryAutomation Query"
        rstContracts.MoveNext
    Loop
    
    rstContract.MoveNext
Loop

ExcelObj.Workbooks.Close

End Sub

Any help would be greatly appreciated!
 
Last edited:
Could you post your database with some sample data?
 
Avoid using select to get a range.

e.g. use
Code: 
ExcelObj.Rows("1:1").Font.Bold = True

instead of
Code: 
ExcelObj.Rows("1:1").Select
ExcelObj.Selection.Font.Bold = True

Close Excel when you're done with it.
Code: 
ExcelObj.Quit

There are date functions, like day(), month(), year().

e.g.

Code: 
Public Sub createFiles()

    Dim ExcelObj As Excel.Application
    Dim wb As Excel.Workbook
    Dim ws As Excel.Worksheet

    Dim rstContractz As DAO.Recordset
    Dim fileName As String
    Dim invoiceNum As String
    Dim startDate As Date

    startDate = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate]
    If Not IsDate(startDate) Then
        MsgBox "check date"
        Exit Sub
    End If
    
    With CreateObject("Excel.Application")
        Const Sql As String = "SELECT IIf(InStr($, ' '), Trim(Left($, InStr($, ' '))), $) as conname FROM contractor where contractorID = "
        
        With CurrentDb.OpenRecordset("SELECT contractorID from contractor where contractorName NOT LIKE 'All'")

            Do While Not .EOF
                conname = CurrentDb.OpenRecordset(Replace(Sql, "$", "contractorName") & .Fields("contractorID"))(0)
                If Month(startDate) = 1 Then invoiceNum = "1" Else invoiceNum = "2"
                
                fileName = "C:\Users\Administrator\Desktop\Final Invoices\20160" & _
                    Day(startDate) & Right(Year(startDate), 2) & invoiceNum & "_" & _
                    conname & ".xlsx"
                
                If Dir(fileName) = "" Then
                    With ExcelObj
                        With .Workbooks.Add
                            For i = .Worksheets.Count To 3
                                With .Sheets.Add(After:=.Worksheets(.Worksheets.Count))
                                    .Rows("1:1").Font.Bold = True
                                    .Cells.Columns.AutoFit
                                End With
                            Next
                            .SaveAs fileName
                            .Close
                        End With
                    End With
                End If
                .MoveNext
            Loop
        End With
        
        .Quit
    End With
End Sub
 
Command484_Click

You don't seem to be saving the changes to the excel sheet.
I don't know why you're creating and deleting query objects. As far as I can tell 'invoiceSummaryAutomation Query' is never used.
It's much easier to work with code if you split it into smaller chunks.

This compiles but I have no idea if it will run. Use as an example.

Code: 
Private Sub Command484_Click()

    Dim ExcelObj As Excel.Application
    Dim wb As Excel.Workbook
    Dim rstContract As DAO.Recordset
    Dim rstContracts As DAO.Recordset
    Dim fileName As String
    Dim contractor As String
    
    Set ExcelObj = New Excel.Application
    ExcelObj.Visible = False
    ExcelObj.UserControl = True
    ExcelObj.DisplayAlerts = False
                
    contractor = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![contractor].Value

    If contractor = "" Then
        MsgBox ("Please select a contractor!")
        Exit Sub
    Else
        If contractor = "All" Then
            Set rstContract = currentdb.OpenRecordset("SELECT contractorID from contractor WHERE contractorName NOT LIKE 'All'")
        Else
            Set rstContract = currentdb.OpenRecordset("SELECT contractorID from contractor where contractorName = '" & contractor & "'")
        End If
    End If
    
    Do While Not rstContract.EOF
        fileName = "blah"
        If Dir(fileName) = "" Then
            Set wb = ExcelObj.Workbooks.Add
            Set rstContracts = currentdb.OpenRecordset("SELECT * FROM contracts WHERE contractorID = " & rstContract!contractorID)
            
            rstContracts.MoveFirst
            
            createFiles
            
            Do While Not rstContracts.EOF
                GetData1 wb.Worksheets("Sheet1"), rstContracts!coNo
                GetData2 wb.Worksheets("Sheet2"), rstContracts!coNo
                GetData3 wb.Worksheets("Sheet3"), rstContracts!coNo
                
                wb.Worksheets("Sheet1").Activate
                
                wb.SaveAs (fileName)
                wb.Close
                rstContracts.MoveNext
            Loop

        End If

        rstContract.MoveNext
    Loop
    
    ExcelObj.Workbooks.Close
    ExcelObj.DisplayAlerts = True
    ExcelObj.Quit
End Sub

Private Function GetData1(ws As Excel.Worksheet, coNo As String)
    Dim startDate As Date
    Dim enddate As Date
    Dim i As Long
    Dim rs2 As DAO.Recordset
    Dim strSQL As String
    
    startDate = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate]
    enddate = [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate]
    
    strSQL = "SELECT a.tripName, a.coNo, a.busType, a.startDate, a.endDate, a.numDays, a.numAids,  a.dlyServiceTime, " & _
     "a.dlyaidtime, a.baserate, a.baseTotal, a.aidbaserate, a.aidbasetotal, a.aidincrementrate, a.aidincrementtotal, a.incrementalrate, a.incrementaltotal, " & _
     "a.aidTotal As 'aidTotal', a.supplementalrate, a.supplementalTotal, a.fuelCostReimb, " & _
     "a.balance FROM (contractor INNER JOIN contracts ON contractor.contractorID = contracts.contractorID) b INNER JOIN invoicesummary a ON b.coNo = a.coNo " & _
     " WHERE (((a.startDate) >= #" & startDate & "#) And ((a.endDate) <= #" & enddate & "#) And ((a.coNo) = '" & coNo & _
     "'))ORDER BY a.tripName, a.endDate;"

    Set rs2 = currentdb.OpenRecordset(strSQL)
    
    With ws
        For i = 0 To rs2.Fields.Count - 1
            .Range("A1").Offset(0, i).Value = rs2.Fields(i).Name
        Next

        i = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
            .Range("A" & CStr(i + 1)).CopyFromRecordset rs2

        .Range("D2", "D1000").NumberFormat = "mm/dd/yy"
        .Range("E2", "E1000").NumberFormat = "mm/dd/yy"
    End With
    rs2.Close
End Function

Private Function GetData2(ws As Excel.Worksheet, coNo As String)
    Dim strSQL As String
    Dim i As Long
    Dim rs2 As DAO.Recordset
    
    strSQL = "SELECT tripName, description, dateInfo, busType, lastUpdate FROM tripslog WHERE coNo = '" & _
        coNo & "' AND midday = 1 and tripName NOT LIKE '_E%'"
    
    Set rs2 = currentdb.OpenRecordset(strSQL)
    If rs2.RecordCount > 0 Then
        With ws
            For i = 0 To rs2.Fields.Count - 1
                .Range("A1").Offset(0, i).Value = rs2.Fields(i).Name
            Next

            i = .Cells.SpecialCells(xlCellTypeLastCell).Row
            .Range("A" & CStr(i + 1)).CopyFromRecordset rs2
            .Range("E2", "E1000").NumberFormat = "mm/dd/yy"
        End With
    End If
    rs2.Close
End Function

Private Function GetData3(ws As Excel.Worksheet, coNo As String)
    Dim strSQL As String
    Dim i As Long
    Dim rs2 As DAO.Recordset
    strSQL = "SELECT * FROM modifications WHERE modDate >= #" & _
        [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceStartDate] & "# AND modDate <= #" & _
        [Forms]![Navigation Main Menu]![NavigationSubform].[Form]![NavigationSubform].[Form]![invoiceEndDate] & "# AND coNo = '" & coNo & "'"
    Set rs2 = currentdb.OpenRecordset(strSQL)
    If rs2.RecordCount > 0 Then
        With ws
            For i = 0 To rs2.Fields.Count - 1
               .Range("A1").Offset(0, i).Value = rs2.Fields(i).Name
            Next

            i = .Cells.SpecialCells(xlCellTypeLastCell).Row
            .Range("A" & CStr(i + 1)).CopyFromRecordset rs2
        End With
    End If
    rs2.Close
End Function
 
static: I'm getting a Syntax Error in FROM clause on the strSQL statement when creating the recordset RS2 in GetData1.

I then tried to replace the set rs2 = invoicing.openrecordset(strsql) with my

Set qfd = invoicing.QueryDefs("tempQuery")
Set RS2 = qfd.OpenRecordset(Type:=dbOpenDynaset)

lines to populate the recordset RS2 (just because it "worked" in the past) and it is causing the same errors to happen in YOUR code.

So I'm thinking that the errors that i'm getting have something to do with using my querydef to populate the recordset ?

Any idea why I would be getting an error on the strSQL statement? I'm troubleshooting it to no avail. I'm about to ragequit this sh!1, I can't understand the double join grouping...
 
Last edited:
Nevermind give me some time to try a couple things. I've been pretty darn dense in putting this together.
 
You must log in or register to reply here.

Similar threads

W
Very odd VBA error when using Split()
Replies
15
Views
921
WillockBoy
W
I
MYSQL Connection on AWS
Replies
6
Views
495
cheekybuddha
cheekybuddha
A
Solved Nz has started throwing up an error message
2
Replies
23
Views
1,010
The_Doc_Man
The_Doc_Man
Charax
Error Installing SSMA
Replies
16
Views
666
Pat Hartman
P
R
Solved Dreaded 'Write Conflict' error after adding a new field to Access form
Replies
12
Views
704
ricardocpa
R

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom