VBA email using database to contruct email - crash afterwards

[peskywinnets]

I've a bit of VBA that cycles through a database & for any sales invoices that haven't already been emailed. When a customer needs emailing, the code 'puts together' an email from static text fields in the database itself.

It all works.....nothing crashes when it actually is running ....except after the code has run, if I then try to do anything like compact or exit access, access crashes. If I don't try to do anything like compact the database etc, the access will run ok (so it looks like some 'actions' are causing access to crash after the email VBA code has run)

I'm sure it's related to this code (as access only crashes after the code has been rum), but I'm not experienced enough in either VBA or access to get to the bottom of it.

Here's the code...

(I'm sure to a coder, it's as ugly as hell....it's been kludged together from others' code - sorry!)

Public Function AutoEmail_New()

Dim sSQL As String
Dim mailto As String
Dim strCR As String
strCR = Chr(10)
Dim i As Integer
Dim db As Database
Dim rs As Recordset
Dim PrevInvoiceNo As Long
PrevInvoiceNo = 0
Set db = CurrentDb
Set rs = CurrentDb.OpenRecordset("Select * from Sales where InvoiceEmailed = False  order by InvoiceEmailed DESC, InvoiceNo ASC")
DoCmd.SetWarnings False
DoCmd.OpenQuery "SetPrintInvoiceToNo", , acEdit

Do While Not rs.EOF

    mailto = rs!Email
    mailsub = rs!EmailSubject
    emailmsg = rs!EmailHeader & strCR & strCR & rs!EmailBody1 & rs!EmailBody2 & strCR & strCR & rs!EmailBody3 & strCR & strCR & rs!EmailFooter1 & strCR & strCR & rs!EmailFooter2 & strCR & "Robert"

    If rs!AmazonPostageChecked = False Then GoTo jmp
    If rs!Email_Later = True Then GoTo jmp
    
    If rs!InvoiceNo <> PrevInvoiceNo Then

    sSQL = "UPDATE Sales SET Sales.PrintInvoice = True WHERE (((Sales.InvoiceNo)=" & rs!InvoiceNo & "))"
     DoCmd.RunSQL sSQL

'_____________Below is the nonEC (doesn't matter which currency)_________________________________________________________
    
If rs!ECorNOT = "nonEC" Then
    
    DoCmd.OpenReport "rptSalesReceiptMain_NoVAT", acViewPreview

    MSG1 = MsgBox("Does the receipt look ok?", vbYesNo, "Confirm Details OK") 'latest entry
    
    If MSG1 = vbYes Then
        DoCmd.SendObject acSendReport, "rptSalesReceiptMain_NoVAT", acFormatPDF, mailto, , , mailsub, emailmsg, True
        DoCmd.OpenQuery "SetPrintInvoiceToNo", , acEdit
        DoCmd.Close acReport, "rptSalesReceiptMain_NoVAT", acSaveNo
        GoTo housekeep
    Else
        MsgBox "Please Correct receipt later"
        DoCmd.OpenQuery "SetPrintInvoiceToNo", , acEdit
        DoCmd.Close acReport, "rptSalesReceiptMain_NoVAT", acSaveNo
        GoTo jmp
    End If

'_____________Below is for (EC) £ and UK Only_________________________________________________________
Else
    'If rs!Currency = "GBP" And rs!ShippingCountry = "United Kingdom" Then
     If rs!Currency = "GBP" Then
    
    If rs!Source = "amazon FBA" And rs!Subsource = "amazon.co.uk" Then  ' use this type of line to overide having to opening/viewing the invoice
    DoCmd.SendObject acSendReport, "rptSalesReceiptMain_UK", acFormatPDF, mailto, , , mailsub, emailmsg, False
    GoTo housekeep
    ElseIf rs!Source = "ebay" And rs!ShippingMethod = "RM 2" Then
    DoCmd.SendObject acSendReport, "rptSalesReceiptMain_UK", acFormatPDF, mailto, , , mailsub, emailmsg, False
    GoTo housekeep
    ElseIf rs!Source = "ebay" And rs!ShippingMethod = "RM 1" Then
    DoCmd.SendObject acSendReport, "rptSalesReceiptMain_UK", acFormatPDF, mailto, , , mailsub, emailmsg, False
    GoTo housekeep
    ElseIf rs!Source = "ebay" And rs!ShippingMethod = "RM 1 Signed For" Then
    DoCmd.SendObject acSendReport, "rptSalesReceiptMain_UK", acFormatPDF, mailto, , , mailsub, emailmsg, False
    GoTo housekeep
    ElseIf rs!Source = "ebay" And rs!ShippingMethod = "RM 2 Signed For" Then
    DoCmd.SendObject acSendReport, "rptSalesReceiptMain_UK", acFormatPDF, mailto, , , mailsub, emailmsg, False
    GoTo housekeep
    ElseIf rs!Source = "ebay" And rs!ShippingMethod = "RM Int. Small Packets" Then
    DoCmd.SendObject acSendReport, "rptSalesReceiptMain_UK", acFormatPDF, mailto, , , mailsub, emailmsg, False
    GoTo housekeep
    End If
    
    DoCmd.OpenReport "rptSalesReceiptMain_UK", acViewPreview
    MSG1 = MsgBox("Does the receipt look ok?", vbYesNo, "Confirm Details OK") 'latest entry
    
    If MSG1 = vbYes Then

send_without_showing_Email:
    DoCmd.Close acReport, "rptSalesReceiptMain_UK", acSaveNo
    DoCmd.SendObject acSendReport, "rptSalesReceiptMain_UK", acFormatPDF, mailto, , , mailsub, emailmsg, True
    DoCmd.OpenQuery "SetPrintInvoiceToNo", , acEdit
    GoTo housekeep
    Else
    MsgBox "Please Correct receipt later"
    DoCmd.OpenQuery "SetPrintInvoiceToNo", , acEdit
    DoCmd.Close acReport, "rptSalesReceiptMain_UK", acSaveNo
    GoTo jmp
    End If  

    Else
    
'_____________Below is for (EC) EUR and Eurozone Only_________________________________________________________

     If rs!Currency = "EUR" Then
    
        If rs!Source = "amazon FBA" And rs!Subsource = "amazon.de" Then          ' use this type of line to overide having to opening/viewing the invoice
        DoCmd.SendObject acSendReport, "rptSalesReceiptMain_EUR", acFormatPDF, mailto, , , mailsub, emailmsg, False
        GoTo housekeep
        ElseIf rs!Source = "amazon FBA" And rs!Subsource = "amazon.es" Then
        DoCmd.SendObject acSendReport, "rptSalesReceiptMain_EUR", acFormatPDF, mailto, , , mailsub, emailmsg, False
        GoTo housekeep
        ElseIf rs!Source = "amazon FBA" And rs!Subsource = "amazon.fr" Then
        DoCmd.SendObject acSendReport, "rptSalesReceiptMain_EUR", acFormatPDF, mailto, , , mailsub, emailmsg, False
        GoTo housekeep
       ' ElseIf rs!Source = "amazon FBA" And rs!Subsource = "amazon.it" And rs!MultiItemOrder = False Then
        ElseIf rs!Source = "amazon FBA" And rs!Subsource = "amazon.it" Then
        DoCmd.SendObject acSendReport, "rptSalesReceiptMain_EUR", acFormatPDF, mailto, , , mailsub, emailmsg, False
        GoTo housekeep
        End If
       
        DoCmd.OpenReport "rptSalesReceiptMain_EUR", acViewPreview
        MSG1 = MsgBox("Does the receipt look ok?", vbYesNo, "Confirm Details OK?")
        
        If MSG1 = vbYes Then
        
send_without_showing_Email_EC:
        DoCmd.Close acReport, "rptSalesReceiptMain_EUR", acSaveNo
        DoCmd.SendObject acSendReport, "rptSalesReceiptMain_EUR", acFormatPDF, mailto, , , mailsub, emailmsg, True
        GoTo housekeep
        Else
        MsgBox "Please Correct receipt later"
        Debug.Print rs.Fields("InvoiceNo") & " " & rs.Fields("Currency") & " Not Sent"
        DoCmd.OpenQuery "SetPrintInvoiceToNo", , acEdit
        DoCmd.Close acReport, "rptSalesReceiptMain_EUR", acSaveNo
        DoCmd.SetWarnings False
        GoTo jmp
        End If
 
    End If
    End If
    End If
    End If
    
housekeep:

    PrevInvoiceNo = rs!InvoiceNo
    rs.Edit
    rs!InvoiceEmailed = 1
    rs.Update
    
jmp:
    DoCmd.OpenQuery "SetPrintInvoiceToNo", , acEdit
    rs.MoveNext
    
Loop
DoCmd.OpenQuery "SetPrintInvoiceToNo", , acEdit
DoCmd.SetWarnings True
rs.Close
Set rs = Nothing
Set dbs = Nothing
db.Close

Are there any obvious ommisions that might exit the routine gracefully thereby (hopefully) stopping access crashing.

 

[CJ_London]

suggest comment out your setwarnings so you can see any errors being generated then step through the code until you find the error causing the problem. With all the jumping around, opening queries and the like it could be anything

 

[Galaxiom]

First thing when ugly code like that doesn't work is to clean up the code. Hard-to-read code is hard to review code.

Firstly move some of the blocks out into separate subs/functions and call them from the main procedure.

Second. Get rid of the gotos. They make code very hard to follow. Implementing the first suggestion will help achieve much of this.

Thirdly, rationalise the If tests. No point repeatedly testing for the same things. Also consider Select Case constructs instead.