Trying to send an email from Query results and add attachment

[Paul Ager]

Hi,

I hope someone can help. I'm trying to add an attachment to an email from email addresses that are generated from a query. I've tried to amalgamate two pieces of code to form one but I am getting the Complie Error: 'End If without block If' message. I'd really appreciate it if someone could cast their expert eye over the code below and see if they can find a solution.

 
Private Sub email_exp1_Click() 
    On Error Goto Err_email_exp1_Click 
     
    Dim MyDb As DAO.Database 
    Dim rsEmail As DAO.Recordset 
    Dim qdf As DAO.QueryDef 
    Dim prm As DAO.Parameter 
    Dim strEmail As String 
    Dim strMsg As String 
    Dim oLook As Object 
    Dim oMail As Object 

    Set MyDb = CurrentDb 
    Set qdf = MyDb.QueryDefs("qryexp_may11") 
     
    For Each prm In qdf.Parameters 
        prm.Value = Eval(prm.Name) 
    Next 
     
    Set rsEmail = qdf.OpenRecordset() 
    Set oLook = CreateObject("Outlook.Application") 
     
    With rsEmail 
        .MoveFirst 
        Do Until rsEmail.EOF 
            If IsNull(.Fields(0)) = False Then 
                 
                Set oMail = oLook.createitem(0) 
                With oMail 
                    .to = .Fields(0) 
                    .body = "See attached" 
                    .Subject = "Is the file attached" 
                    .Attachments.Add("\\mynetwork\mynetworkfolder\example.doc") 
                    .Send 
                End If 
                .MoveNext 
            Loop 
        End With 
         
        Set oMail = Nothing 
        Set oLook = Nothing 
         
Err_email_exp1_Click: 
        MsgBox Err.Description 
        Resume Exit_email_exp1_Click 
         
    End Sub

I've been studying this code for a while and cannot see anyway forward. Any help would be great!

Paul

[Paul Ager]

Eureka! I found the solution, please see working code below.

 
Private Sub email_exp1_Click()
 
Dim MyDb As DAO.Database
Dim rsEmail As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim strEmail As String
Dim strMsg As String
Dim oLook As Object
Dim oMail As Object
Set MyDb = CurrentDb
Set qdf = MyDb.QueryDefs("qryexp_may11")
For Each prm In qdf.Parameters
    prm.Value = Eval(prm.Name)
Next
Set rsEmail = qdf.OpenRecordset()
Set oLook = CreateObject("Outlook.Application")
With rsEmail
        .MoveFirst
        Do Until rsEmail.EOF
        myRecipient = .Fields(0)
            If IsNull(myRecipient) = False Then
                Set oLook = CreateObject("Outlook.Application")
                Set oMail = oLook.createitem(0)
                With oMail
                    .to = myRecipient
                    .body = "See attached"
                    .Subject = "Test Email"
                    .Attachments.Add ("\\mynetwork\mynetworkfolder\test.doc")
                    .Send
                End With
            End If
                    .MoveNext
        Loop
End With
Set oMail = Nothing
Set oLook = Nothing
End Sub

Thanks again!