Add Attachment to Email via Query

[Paul Ager]

Hi,
I am trying to add an attachment to an email from email addresses that are generated from a query in Access. I've tried to amalgamate to 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


Many thanks in advance.

Paul

[OBP]

You have an End With missing that ends the
With oMail

[Paul Ager]

Thanks OBP. I've placed the End With after .Send which seems to have by passed the complie error but now I get another message lol. Run Time error ‘91’: Object variable or With block variable not set. It points to the .to = .Fields(0) line in the code. Any ideas?

[OBP]

It is possible that the VBA editor is confused by the fact that you have a With within a with, so it doesn't know that
.Fields(0)
is allocated to the first with. I would suggest that you set .Fields(0) to a variable to pass to the inner with set.

[Paul Ager]

Eureka! Thanks for your help OBP, 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!