Help with Email VBA

[Jonny45wakey]

Hi all

I have the following code behind the On Click Event of a command button on a form, the code basically generates an email and looks up email addresses in a query called "qryGATE2_Email", currently there is only one email address in the query but if there is more than 1 email i get an error message.

Run-time error '91'
Object variable or With block variable not set

The email still sends but throws up the above error

Any ideas?

Thanks

Jonny

Private Sub Command96_Click()
Dim olLook As Object 'Start MS Outlook
Dim olNewEmail As Object 'New email in Outlook
Dim strContactEmail As String 'Contact email address
Dim MyDb As DAO.Database
Dim rsEmail As DAO.Recordset
Dim sToName As String

Set MyDb = CurrentDb()
Set rsEmail = MyDb.OpenRecordset("qryGATE2_Email", dbOpenSnapshot)

Set olLook = CreateObject("Outlook.Application")
Set olNewEmail = olLook.createitem(0)

With rsEmail
.MoveFirst

Do Until rsEmail.EOF
If IsNull(.Fields(2)) = False Then


stEnquiryID = Me.EnquiryID
stCustomer = Me.Customer


olNewEmail.To = .Fields(2)
olNewEmail.SentOnBehalfOfName = "BusinessManagementSystem@doitwell.co.uk"
olNewEmail.body = "ENQUIRY No:" & " " & Me.EnquiryID.Value & " " & "CUSTOMER:" & " " & Me.Customer.Value & " " & "Requires Credit Checks to be carried out, please liaise with the Sales Department in relation to this Customer Enquiry - - - - - PROJECT MOVED TO GATE 2 (FEASIBILITY)"
olNewEmail.Subject = "GATE 1 Pre-Order Enquiry Approved"
'If Me.chkAttachXLS = True Then olNewEmail.attachments.Add strFilepath
olNewEmail.display
olNewEmail.send
Set olLook = Nothing
Set olNewEmail = Nothing
End If
.MoveNext
Loop
End With
Me.LIVEGATE.Value = "GATE 2"
Me.Gate1Approved = Environ("USERNAME")
Me.Gate1DateApp = Now()
End Sub

 

[Gasman]

And the line where the error happens is?

 

[Jonny45wakey]

And the line where the error happens is?

Thanks Gasman

The line is:

olNewEmail.To = .Fields(2)

 

[Minty]

Put the value into a variable then use that - the outlook object doesn't understand the recordset fields reference.

 Option Compare Database
Option Explicit

Private Sub Command96_Click()
    Dim olLook As Object 'Start MS Outlook
    Dim olNewEmail As Object 'New email in Outlook
    Dim strContactEmail As String 'Contact email address
    Dim MyDb As DAO.Database
    Dim rsEmail As DAO.Recordset
    Dim sToName As String
   
    Dim strEmailTo As String



    Set MyDb = CurrentDb()
    Set rsEmail = MyDb.OpenRecordset("qryGATE2_Email", dbOpenSnapshot)

    Set olLook = CreateObject("Outlook.Application")
    Set olNewEmail = olLook.createitem(0)

    With rsEmail
        .MoveFirst

        Do Until rsEmail.EOF
            If IsNull(.Fields(2)) = False Then
                stEnquiryID = Me.EnquiryID
                stCustomer = Me.Customer
               
                strEmailTo = .Fields(2)

                olNewEmail.To = strEmailTo
                olNewEmail.SentOnBehalfOfName = "BusinessManagementSystem@doitwell.co.uk"
                olNewEmail.body = "ENQUIRY No:" & " " & Me.EnquiryID.Value & " " & "CUSTOMER:" & " " & Me.Customer.Value & " " & "Requires Credit Checks to be carried out, please liaise with the Sales Department in relation to this Customer Enquiry - - - - - PROJECT MOVED TO GATE 2 (FEASIBILITY)"
                olNewEmail.Subject = "GATE 1 Pre-Order Enquiry Approved"
                'If Me.chkAttachXLS = True Then olNewEmail.attachments.Add strFilepath
                olNewEmail.display
                olNewEmail.send
                Set olLook = Nothing
                Set olNewEmail = Nothing
            End If
            .MoveNext
        Loop
    End With
    Me.LIVEGATE.Value = "GATE 2"
    Me.Gate1Approved = Environ("USERNAME")
    Me.Gate1DateApp = Now()
End Sub

 

[Gasman]

Really would be better if you indented and used code tags?
Some variables are also not declared?

I get

Try

olNewEmail.To = .Fields(2).Value

Private Sub Command96_Click()
    Dim olLook As Object    'Start MS Outlook
    Dim olNewEmail As Object    'New email in Outlook
    Dim strContactEmail As String    'Contact email address
    Dim MyDb As DAO.Database
    Dim rsEmail As DAO.Recordset
    Dim sToName As String

    Set MyDb = CurrentDb()
    Set rsEmail = MyDb.OpenRecordset("qryGATE2_Email", dbOpenSnapshot)

    Set olLook = CreateObject("Outlook.Application")
    Set olNewEmail = olLook.createitem(0)

    With rsEmail
        .MoveFirst

        Do Until rsEmail.EOF
            If IsNull(.Fields(2)) = False Then


                stEnquiryID = Me.EnquiryID
                stCustomer = Me.Customer


                olNewEmail.To = .Fields(2)
                olNewEmail.SentOnBehalfOfName = "BusinessManagementSystem@doitwell.co.uk"
                olNewEmail.body = "ENQUIRY No:" & " " & Me.EnquiryID.Value & " " & "CUSTOMER:" & " " & Me.Customer.Value & " " & "Requires Credit Checks to be carried out, please liaise with the Sales Department in relation to this Customer Enquiry - - - - - PROJECT MOVED TO GATE 2 (FEASIBILITY)"
                olNewEmail.Subject = "GATE 1 Pre-Order Enquiry Approved"
                'If Me.chkAttachXLS = True Then olNewEmail.attachments.Add strFilepath
                olNewEmail.display
                olNewEmail.send
                Set olLook = Nothing
                Set olNewEmail = Nothing
            End If
            .MoveNext
        Loop
    End With
    Me.LIVEGATE.Value = "GATE 2"
    Me.Gate1Approved = Environ("USERNAME")
    Me.Gate1DateApp = Now()
End Sub