Code not running on "Got Focus"

[HansV]

Sorry - I see what happened: you renamed the command button from cmdOK to cmdEmailPrint, but left the code for cmdOK (which uses ConvertReportToPDF) in there.

The error is caused by the lines

Code: Select all

            .Recipients.Add(rst![EMAIL]).Type = 2
            .Recipients.Add(rst![ContactEmail]).Type = 2

The EMAIL and ContactEmail fields are blank, so Outlook cannot add CC recipients. You could get around this as follows:

Code: Select all

            If Not IsNull(rst![EMAIL]) Then
                .Recipients.Add(rst![EMAIL]).Type = 2
            End If
            If Not IsNull(rst![ContactEmail]) Then
                .Recipients.Add(rst![ContactEmail]).Type = 2
            End If

[Leesha]

Hi Hans,
I put in the code and now get an error that there has to be at least one name or contact group in the To, CC or BCC Box. Billing Email does have an email adress in it. I put in mine so that the invoices don't go out by accident to the indended people till I'm sure everthing is all set.

Leesha

[HansV]

Sigh... the ContactEmail field looks empty, but it isn't null, it contains "".

Use this:

Code: Select all

       'CC email
            If rst![EMAIL] & "" <> "" Then
                .Recipients.Add(rst![EMAIL]).Type = 2
            End If
       'BCC email
            If rst![ContactEmail] & "" <> "" Then
                .Recipients.Add(rst![ContactEmail]).Type = 3
            End If

[Leesha]

Thank you so much for sticking with me on this!! They all ran. I still get the occassional "Type mismatch" but if I reclick the cmd button the emails restart and ultimately they all go out. I can live with that although it does drive me buggy wondering what is causing it.

Now I have to recreate this for another type of auto email report that they need to go out but am determined to get if set up on my own :-). I was pretty tickled that I was able to figure out how to get the body of the email to be constructed from controls on the form vs hard code it. I was "thinking like Hans"!

Thanks!
Leesha

[HansV]

There are four blocks that set the recipients: two in the On Click event of the command button, and two in the On Got Focus event. Did you change all of them?

If the problem persists, change the line

Code: Select all

    On Error GoTo ErrHandler

in both event procedures to

Code: Select all

    On Error GoTo 0

If the error occurs again, you'll be given the option to Debug. If you click Debug, the line that caused the error will be highlighted, and you can hover the mouse pointer over variables in the code to see their value.

[Leesha]

OMG Hans! You are the best. I hadn't gotten around to removing the code from the got focus event since I wasn't sure if I would eventually use that instead of the click event. It didn't occur to me that it would be triggoring when I clicked the cmd button but it makes sense. Big Daaaaaaa! Anyway, taking it made the code run without any issues. I'm thrilled and soooooooooooo glad to be done with this one!!! This has been another major learning piece.

Thanks so much,
Leesha

[HansV]

In fact, if you have the code in the On Got Focus event, you can remove the On Click event procedure.

[Leesha]

In fact, if you have the code in the On Got Focus event, you can remove the On Click event procedure.

I will keep that in mind once we get through the trouble shooting of this new process.

Thanks!

[Leesha]

Hi Hans,
I am not getting any errors for the new auto email that I sent up by copying and updating the info in he previous code that you've been working on with me. The thing I noticed is that reports aren't printing and being send separately (there are about 2000) but instead are all going into the first record in the list. I'm not sure what I missed.

Dim strWhere As String
Dim strSQL As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strFilename As String
Dim outApp As Object
Dim outMsg As Object
Dim blnStart As Boolean

On Error Resume Next
' Try to get running instance of Outlook
Set outApp = GetObject(Class:="Outlook.Application")
If outApp Is Nothing Then
' If Outlook wasn't running, start it
Set outApp = CreateObject(Class:="Outlook.Application")
If outApp Is Nothing Then
' We failed to start Outlook, so get out
MsgBox "We can't start Outlook, sorry!", vbCritical
Exit Sub
End If
' Set a flag that we started Outlook
blnStart = True
End If
On Error GoTo ErrHandler

' Create the where-condition
strWhere = " WHERE EmailFaxSent = False"

If Not IsNull(Me.txtStart) Then
'strWhere = strWhere & " AND BillingPeriodStartDate >= #" & Format(Me.txtStart, "yyyy-mm-dd") & "#"
End If
If Not IsNull(Me.txtEnd) Then
'strWhere = strWhere & " AND BillingPeriodEndDate <= #" & Format(Me.txtEnd, "yyyy-mm-dd") & "#"
End If
' ***** Change 10 to the number of records to process *****
strSQL = "SELECT TOP 300 * FROM [tblHellWeekautoemail]" & strWhere






Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
Do While Not rst.EOF
glngInvoiceID = rst!InvoiceID
strFilename = gstrPath & rst!WalmartNumber & "-" & _
rst!STORE_ID & Format(Me.txtStart, " mmmm yyyy") & " Missing Control Sheets" & ".pdf"
' Export report to PDF
' ConvertReportToPDF "rptInvoiceAuto", , strFilename, , False
DoCmd.OutputTo acOutputReport, "rptHellweekMissingControlSheets", acFormatPDF, strFilename


' Create a new e-mail message
Set outMsg = outApp.CreateItem(0) ' olMailItem
With outMsg
' Use the e-mail address field
'Main Email
.Recipients.Add (rst![EMAIL])
'CC email
' If Not IsNull(rst![EMAIL]) Then
' .Recipients.Add(rst![EMAIL]).Type = 2
'End If
'If Not IsNull(rst![ContactEmail]) Then
' .Recipients.Add(rst![ContactEmail]).Type = 2
'End If


' Change the subject as needed
.Subject = Me.Subject
' Change the body text as needed& vbCrLf & vbCrLf & Me.comment3
.Body = Me.Comment1 & vbCrLf & vbCrLf & Me.comment2 & vbCrLf & vbCrLf & "Sincerely," & vbCrLf & vbCrLf & "Rebecca Turner"
' Attach the PDF file
.Attachments.Add strFilename
' Use ONE of the two following lines, not both
.send ' to edit the message before sending
End With

'Set EmailFaxSent field to True, and EmailDateTimeSent to Now
rst.Edit
rst!EmailFaxSent = True
rst!EmailDateTimeSent = Now
rst.Update

' Optional: delete the PDF file after creating the e-mail
' Delete or comment out the next line if you don't want to delete the file
Kill strFilename
rst.MoveNext
' Me.lbxInvoice.Requery
Loop

' Optional: requery the list box
Me.lbxInvoice.Requery

'Updates dates sent in tbl invoice
'DoCmd.OpenQuery "qryUpdateInvoiceAutoEmailDateSent"
'MsgBox "Emails are complete"


ExitHandler:
On Error Resume Next
rst.Close
Set rst = Nothing
Set dbs = Nothing
If blnStart Then
outApp.Quit
End If
Set outMsg = Nothing
Set outApp = Nothing
Exit Sub

ErrHandler:
If Err = 2501 Then
Resume Next
Else
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End If

[Leesha]

Hi! I figured it out! It wasn't in this code but was in the open event of the report itself!!
Leesha

[HansV]

Thanks for the feedback! I was about to start looking at your code!

[Leesha]

NP! I didn't want to waste your time!! I was determined to figure it out and was "thinking like Hans" and looking everywhere which is when I found the code in the report.

Question, is there code that can skip emails that aren't in the correct format? Right now if the format is incorrect it stops and gives a message that the format is incorrect or not recognizable.

Thanks!
Leesha

[HansV]

Can you find out which line causes the error? You can change On Error GoTo ErrHandler to On Error GoTo 0 temporarily to get the opportunity to debug.

[Leesha]

Hi Hans!
Well, due to your wonderful help and patience I've created a monster!! The end user is so thrilled with the auto email that they would like to know if its possible to attach and send two reports in the same email. Before I start playing with the code to attempt this, is it even possible? I don't want to waste my time, or yours so I'm sure to need help at some point trying to do this.

Also, related to the emails.......what is the format, if any, if the user wanted to put more than one email address in a control? They currently have been putting in multiple email addresses in a text box, separating them with a comma but that always results in the code blowing up stating that the format is not recognized or something to that effect. I believe that their mail merge in excel allowed the comma and would send the email to all the addresses in the cell. Does this work for Access or do they need a semi colon or some other separating character?


Thanks!
Leesha

[HansV]

The line

Code: Select all

        .Recipients.Add (rst![EMAIL])

will allow only one recipient to be added. If you want to allow multiple recipients, separated by commas, you can declare a variable arrNames and a variable i at the beginning of the procedure:

Code: Select all

    Dim arrNames As Variant
    Dim i As Long

and use it as follows:

Code: Select all

        arrNames = Split(rst!EMAIL, ",")
        For i = 0 To UBound(arrNames)
            .Recipients.Add arrNames(i)
        Next i

If you want to add CC or BCC recipients, it's similar, except you have to specify the type.

[Leesha]

Awesome! I will give it a shot. This will save me a great deal of time due to not having to add multiple text boxes for individual email addresses!

Any thoughts on whether I can attach two reports via code to the email? "The end user is so thrilled with the auto email that they would like to know if its possible to attach and send two reports in the same email. Before I start playing with the code to attempt this, is it even possible? I don't want to waste my time, or yours so I'm sure to need help at some point trying to do this."

Thanks
Leesha

[HansV]

You can run the code to convert a report to PDF twice, with two different reports and file names. You can then add both as attachments.

[Leesha]

Hi Hans,
I got this work OK when I only used the main email [email] and not the cc's. When I put in the cc email addresses I get an error re a "End if Without Block If". I can find where it's coming from.

This is the spot where the error is:

Code: Select all

 If Not IsNull(rst![billing EMAIL]) Then
             arrNames = Split(rst![billing EMAIL].Type = 2, ",")
        For i = 0 To UBound(arrNames)
            .Recipients.Add arrNames(i)
            End If

Thanks,
Leesha

Code: Select all

Dim strWhere As String
    Dim strSQL As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strFilename As String
    Dim outApp As Object
    Dim outMsg As Object
    Dim blnStart As Boolean
    Dim arrNames As Variant
    Dim i As Long
    
    On Error Resume Next
    ' Try to get running instance of Outlook
    Set outApp = GetObject(Class:="Outlook.Application")
    If outApp Is Nothing Then
        ' If Outlook wasn't running, start it
        Set outApp = CreateObject(Class:="Outlook.Application")
        If outApp Is Nothing Then
            ' We failed to start Outlook, so get out
            MsgBox "We can't start Outlook, sorry!", vbCritical
            Exit Sub
        End If
        ' Set a flag that we started Outlook
        blnStart = True
    End If
    On Error GoTo ErrHandler

    ' Create the where-condition
    strWhere = " WHERE EmailFaxSent = False"
    
    If Not IsNull(Me.txtStart) Then
        'strWhere = strWhere & " AND BillingPeriodStartDate >= #" & Format(Me.txtStart, "yyyy-mm-dd") & "#"
    End If
    If Not IsNull(Me.txtEnd) Then
        'strWhere = strWhere & " AND BillingPeriodEndDate <= #" & Format(Me.txtEnd, "yyyy-mm-dd") & "#"
    End If
    ' ***** Change 10 to the number of records to process *****
    strSQL = "SELECT ALL * FROM [tblHellWeekautoemail]" & strWhere






    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
    Do While Not rst.EOF
        glngInvoiceID = rst!InvoiceID
        strFilename = gstrPath & rst!WalmartNumber & "-" & _
            rst!STORE_ID & Format(Me.txtStart, " mmmm yyyy") & " Missing Control Sheets" & ".pdf"
        ' Export report to PDF
'        ConvertReportToPDF "rptInvoiceAuto", , strFilename, , False
         DoCmd.OutputTo acOutputReport, "rptHellweekMissingControlSheets", acFormatPDF, strFilename
        

        ' Create a new e-mail message
        Set outMsg = outApp.CreateItem(0) ' olMailItem
        With outMsg
            ' Use the e-mail address field
       'Main Email
             arrNames = Split(rst!EMAIL, ",")
        For i = 0 To UBound(arrNames)
            .Recipients.Add arrNames(i)
        Next i
            
            '.Recipients.Add (rst![EMAIL])
       'CC email
            
            If Not IsNull(rst![billing EMAIL]) Then
             arrNames = Split(rst![billing EMAIL].Type = 2, ",")
        For i = 0 To UBound(arrNames)
            .Recipients.Add arrNames(i)
            End If
            
             
            If Not IsNull(rst![other 1 EMAIL]) Then
             arrNames = Split(rst![other 1 EMAIL].Type = 2, ",")
        For i = 0 To UBound(arrNames)
            .Recipients.Add arrNames(i)
            End If
             
        If Not IsNull(rst![owner2EMAIL]) Then
             arrNames = Split(rst![ownerEMAIL2].Type = 2, ",")
        For i = 0 To UBound(arrNames)
            .Recipients.Add arrNames(i)
            End If
            
       
            ' Change the subject as needed
            .Subject = "Test Email"
            ' Change the body text as needed& vbCrLf & vbCrLf & Me.comment3
           .Body = Me.Comment1 & vbCrLf & vbCrLf & Me.comment2 & vbCrLf & vbCrLf & "Sincerely," & vbCrLf & vbCrLf & "Rebecca Turner"
            ' Attach the PDF file
            .Attachments.Add strFilename
            ' Use ONE of the two following lines, not both
            .send ' to edit the message before sending
        End With

        'Set EmailFaxSent field to True, and EmailDateTimeSent to Now
        rst.Edit
        rst!EmailFaxSent = True
        rst!EmailDateTimeSent = Now
        rst.Update

        ' Optional: delete the PDF file after creating the e-mail
        ' Delete or comment out the next line if you don't want to delete the file
        Kill strFilename
        rst.MoveNext
      ' Me.lbxInvoice.Requery
    Loop

    ' Optional: requery the list box
    Me.lbxInvoice.Requery

'Updates dates sent in tbl invoice
'DoCmd.OpenQuery "qryUpdateInvoiceAutoEmailDateSent"
 'MsgBox "Emails are complete"


ExitHandler:
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    Set dbs = Nothing
    If blnStart Then
        outApp.Quit
    End If
    Set outMsg = Nothing
    Set outApp = Nothing
    Exit Sub

ErrHandler:
    If Err = 2501 Then
        Resume Next
    Else
        MsgBox Err.Description, vbExclamation
        Resume ExitHandler
    End If

[HansV]

1) rst![billing EMAIL].Type = 2 doesn't make sense. Type = 2 should be set for the mail recipient, not for the field of the recordset.
2) You don't have a Next corresponding to the For lines.
3) The code is difficult to analyze because of the inconsistent indentation.

The part that you mention first should be like this:

Code: Select all

            If Not IsNull(rst![billing EMAIL]) Then
                arrNames = Split(rst![billing EMAIL], ",")
                For i = 0 To UBound(arrNames)
                    .Recipients.Add arrNames(i)
                Next i
            End If

Note how If aligns with End If, and how For aligns with Next. This allows you to see at a glance what belongs together.

Here is the complete code:

Code: Select all

    Dim strWhere As String
    Dim strSQL As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strFilename As String
    Dim outApp As Object
    Dim outMsg As Object
    Dim blnStart As Boolean
    Dim arrNames As Variant
    Dim i As Long

    On Error Resume Next
    ' Try to get running instance of Outlook
    Set outApp = GetObject(Class:="Outlook.Application")
    If outApp Is Nothing Then
        ' If Outlook wasn't running, start it
        Set outApp = CreateObject(Class:="Outlook.Application")
        If outApp Is Nothing Then
            ' We failed to start Outlook, so get out
            MsgBox "We can't start Outlook, sorry!", vbCritical
            Exit Sub
        End If
        ' Set a flag that we started Outlook
        blnStart = True
    End If
    On Error GoTo ErrHandler

    ' Create the where-condition
    strWhere = " WHERE EmailFaxSent = False"
    
    If Not IsNull(Me.txtStart) Then
        'strWhere = strWhere & " AND BillingPeriodStartDate >= #" & Format(Me.txtStart, "yyyy-mm-dd") & "#"
    End If
    If Not IsNull(Me.txtEnd) Then
        'strWhere = strWhere & " AND BillingPeriodEndDate <= #" & Format(Me.txtEnd, "yyyy-mm-dd") & "#"
    End If
    ' ***** Change 10 to the number of records to process *****
    strSQL = "SELECT ALL * FROM [tblHellWeekautoemail]" & strWhere

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
    Do While Not rst.EOF
        glngInvoiceID = rst!InvoiceID
        strFilename = gstrPath & rst!WalmartNumber & "-" & _
            rst!STORE_ID & Format(Me.txtStart, " mmmm yyyy") & " Missing Control Sheets" & ".pdf"
        ' Export report to PDF
'        ConvertReportToPDF "rptInvoiceAuto", , strFilename, , False
         DoCmd.OutputTo acOutputReport, "rptHellweekMissingControlSheets", acFormatPDF, strFilename

        ' Create a new e-mail message
        Set outMsg = outApp.CreateItem(0) ' olMailItem
        With outMsg
            ' Use the e-mail address field
            'Main Email
            arrNames = Split(rst!Email, ",")
            For i = 0 To UBound(arrNames)
                .Recipients.Add arrNames(i)
            Next i

            If Not IsNull(rst![billing EMAIL]) Then
                arrNames = Split(rst![billing EMAIL], ",")
                For i = 0 To UBound(arrNames)
                    .Recipients.Add arrNames(i)
                Next i
            End If

            If Not IsNull(rst![other 1 EMAIL]) Then
                arrNames = Split(rst![other 1 EMAIL], ",")
                For i = 0 To UBound(arrNames)
                    .Recipients.Add(arrNames(i)).Type = 2
                Next i
            End If

            If Not IsNull(rst![owner2EMAIL]) Then
                arrNames = Split(rst![ownerEMAIL2], ",")
                For i = 0 To UBound(arrNames)
                    .Recipients.Add(arrNames(i)).Type = 2
                Next i
            End If

            ' Change the subject as needed
            .Subject = "Test Email"
            ' Change the body text as needed& vbCrLf & vbCrLf & Me.comment3
           .Body = Me.Comment1 & vbCrLf & vbCrLf & Me.comment2 & vbCrLf & vbCrLf & "Sincerely," & vbCrLf & vbCrLf & "Rebecca Turner"
            ' Attach the PDF file
            .Attachments.Add strFilename
            .Send ' to edit the message before sending
        End With

        'Set EmailFaxSent field to True, and EmailDateTimeSent to Now
        rst.Edit
        rst!EmailFaxSent = True
        rst!EmailDateTimeSent = Now
        rst.Update

        ' Optional: delete the PDF file after creating the e-mail
        ' Delete or comment out the next line if you don't want to delete the file
        Kill strFilename
        rst.MoveNext
    Loop

    ' Optional: requery the list box
    Me.lbxInvoice.Requery

    'Updates dates sent in tbl invoice
    'DoCmd.OpenQuery "qryUpdateInvoiceAutoEmailDateSent"
    'MsgBox "Emails are complete"

ExitHandler:
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    Set dbs = Nothing
    If blnStart Then
        outApp.Quit
    End If
    Set outMsg = Nothing
    Set outApp = Nothing
    Exit Sub

ErrHandler:
    If Err = 2501 Then
        Resume Next
    Else
        MsgBox Err.Description, vbExclamation
        Resume ExitHandler
    End If

[Leesha]

Thanks Hans!!!