Server threw an exception

Gasman

Enthusiastic Amateur
Local time
Today, 16:34
Joined
Sep 21, 2011
Messages
16,449
Hi all,

I am trying to export the results of a query to an excel workbook.
The excel object is created, but when I try an open an excel file (I have tried several) it fails with Automation Error, The Server threw an exception - Error 2147417851

All of the code is below and is in development.
I can run macroes in other workbooks no problem and I have trust vba in security setting for excel and able to run macroes in Access.

Where do I start to find the problem please?

Code:
Private Sub Command4_Click()
On Error GoTo Err_Handler

Dim db As Database
Dim xlApp As New Excel.Application
Dim xlWrkBk As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim rstTrades As Recordset, rstIntro As Recordset
Dim strSQL As String, strSQLdate As String, strDBpath As String, strFolder As String, strPaymentsPath As String
Dim lSubmitterID As Long, lxlRow As Long

Const strcJetDate = "\#mm\/dd\/yyyy\#"  'Needed for dates in queries as Access expects USA format.

Set db = CurrentDb()
strDBpath = GetDBPath

'Create new folder if it does not exist
strFolder = Format(Now(), "yyyy-mm-dd")
strPaymentsPath = strDBpath & "Invoice\" & strFolder & "\"

' Test for path to save files, created each week.
If Dir(strPaymentsPath, vbDirectory) = "" Then
    MkDir strPaymentsPath
End If


'Open and reference an instance of the Excel app
Set xlApp = CreateObject("Excel.Application")

' First get all the Submitters that can have an Invoice Run
strSQL = "SELECT tblSubmitter.InvoiceRun, tblSubmitter.SubmitterName, tblSubmitter.SubmitterID FROM tblSubmitter"
strSQL = strSQL & " WHERE (((tblSubmitter.InvoiceRun)=True))"
strSQL = strSQL & " ORDER BY tblSubmitter.SubmitterName;"

Set rstIntro = db.OpenRecordset(strSQL, dbOpenDynaset)

' Any submitter to process?
If rstIntro.EOF Then
    MsgBox "No Submitters found for Invoice Run"
    GoTo ExitSub
End If

' Set date in correct format for query
strSQLdate = Format(Me.txtInvoiceDate, strcJetDate)

' Set submitterID for query
lSubmitterID = rstIntro.Fields("SubmitterID").Value
lSubmitterID = 1


strSQL = "SELECT tblSVSTrades.TradeDate, tblSVSTrades.Forename, tblSVSTrades.Surname, tblSVSTrades.TradeType, tblSVSTrades.NetCost, tblSVSTrades.BuySell, tblSubmitter.SubmitterName, tblIntroCommission.IntroCommission FROM tblSubmitter"
strSQL = strSQL & " INNER JOIN (tblSubmitterClient INNER JOIN ((tblCommission INNER JOIN tblIntroCommission ON tblCommission.CommissionID = tblIntroCommission.CommissionID) INNER JOIN tblSVSTrades ON tblCommission.TradeID = tblSVSTrades.SVSTradesID) ON tblSubmitterClient.SubmitterClientID = tblIntroCommission.SubmitterClientID) ON tblSubmitter.SubmitterID = tblSubmitterClient.SubmitterID"
strSQL = strSQL & " WHERE (((tblIntroCommission.InvoicedDate) = " & strSQLdate & ")  AND ((tblSubmitterClient.SubmitterID)= " & lSubmitterID & "))"
strSQL = strSQL & " ORDER BY tblSVSTrades.SVSTradesID;"

Set rstTrades = db.OpenRecordset(strSQL, dbOpenDynaset)

If Not (rstTrades.BOF And rstTrades.EOF) Then
    ' Open the Excel Template file
    [COLOR="Red"]Set xlWrkBk = xlApp.Workbooks.Open("C:\Temp\SVS Weekly Update.xlsx")[/COLOR]
    'reference the first sheet in the file
    Set xlSht = xlWrkBk.Sheets(1)
    rstTrades.MoveFirst
    lxlRow = 3
    Do While Not rstTrades.EOF
        ' Now enter values in sheet
        xlSht.Cells(xlRow, 1) = rstTrades.Fields("Trade date")
        xlSht.Cells(xlRow, 2) = rstTrades.Fields("Forename")
        xlSht.Cells(xlRow, 3) = rstTrades.Fields("Surname")
        xlSht.Cells(xlRow, 4) = rstTrades.Fields("Trade Type")
        xlSht.Cells(xlRow, 5) = rstTrades.Fields("NetCost")
        xlSht.Cells(xlRow, 6) = rstTrades.Fields("Buy/Sell")
        xlSht.Cells(xlRow, 7) = rstTrades.Fields("SubmitterName")
        xlSht.Cells(xlRow, 8) = rstTrades.Fields("IntroCommission")
        lxlRow = lxlRow + 1
        rstTrades.MoveNext
    Loop
    lxlRow = lxlRow + 2
    xlSht.Cells(xlRow, 7) = "Total"
    xlSht.Cells(xlRow, 8) = "=SUM(H3:H" & lxlRow - 2 & ")"
    ' Now save the workbook
    xlWrkBk.saveas strPaymentsPath & rstTrades.Fields("SubmitterName") & " Invoice.xlsx"
    xlWrkBk.Close
Else
    MsgBox "No trades for " & rstTrades.Fields("SubmitterName")
End If

ExitSub:
    Set db = Nothing
    Set rstIntro = Nothing
    Set rstTrades = Nothing
    Set xlWrkBk = Nothing
    Set xlApp = Nothing
    
Err_Exit:
    Exit Sub
    
Err_Handler:
    MsgBox "Error " & Err.Number & " " & Err.Description
    Resume ExitSub
End Sub
 
I would copy the code to a new routine and remove everything but the lines required to open the workbook. Once that works start adding stuff back in...

Sometimes objects persist if they are not explicitly closed. This can cause enumerated objects/references to get crossed up. Try saving everything and rebooting. This removes the unwanted object instances...
 
Hi Ken,
Sorry I forgot to say that I had rebooted the computer after just trying logging off.

I'll give copying the code a go.

Thank you.
 
OK,
I rebooted the computer, copied the few lines of code to a new database, same problem.
I've emailed the db to home to try out tonight. Fingers crossed. :)
 
Ok - so you're down to not being able to even opening a spreadsheet. What is the error message now?
 
Hi Ken,
Same error message.
I'm responding from home now and the cut down code, just xlapp and xlwrkbk work fine. Slight pause when instantiating the xlapp objext, but other than that no complaint when opening an excel file.
Googling indicates that an addin might be at fault.? I have no Com addins at home, but do have a Foxit pdf in work.
 
So you may need to check the references on the work machine. Not which one(s) you may need for the Outlook stuff. Perhaps Google it or do a search on this site.
 
Hi Ken,

Back in work, started Excel in Administrator mode as the plugin could not be removed on normal start of Excel. Unticked Foxit pdf Creator COM Addin, and closed Excel.

Ran the test sub routine and it opens (or at least does not object to the opening of the file).

Phew!, that is a relief. :-)
 
Not half as glad as I am:D
I had visions of spending days (which I could not afford) trying to get to the bottom of it. The link I found was not for my addin, but another, but fortunately the cure was the same.
Made a lot of progress today as a result.
 
Well this came back to bite me again. Not sure how the plugin was set again, just fortunate that it rang a bell after all this time, my memory not being that great, and all :D
 

Users who are viewing this thread

Back
Top Bottom