Runtime error 424 'Object required' sending VBA emails

[Hoareman]

Hi,

I have been trying to wrist a code to send emails via excel.

All the information I need is contained within the a worksheet, including email address and email body. Email addresses are contained in Column E.
Each row contains slightly different information.

Here is the code:

Sub EmailBody()

Dim SendTo As String
Dim MailBody As String

For Each i In Range("A2:A100")

MailBody = "Dear " & i.Offset(0, 5) & "," & vbCr & vbCr & i.Offset(0, 6) & vbCr & vbCr & i.Offset(0, 7) & vbCr & vbCr & i.Offset(0, 8) & vbCr & vbCr & "Hospital Number: " & i.Value & vbCr & "Exam Date: " & i.Offset(0, 1) & vbCr & "Exam: " & i.Offset(0, 2) & vbCr & vbCr & "Kind regards," & vbCr & vbCr & i.Offset(0, 11) & vbCr & i.Offset(0, 9) & vbCr & i.Offset(0, 10)

SendTo = i.Offset(0, 5).Value

MsgBox MailBody & vbCr & vbCr & SendTo

With outMail
.To = SendTo
.Subject = "Images for QA"
.Body = MailBody
.Display
End With

Next i

End Sub

My problem here is two-fold.

1. I am getting runtime error at the .To = SendTo line (highlighted in yellow)
2. The code was originally more complicated so I have tried to simplify it. My previous problem was that the code was creating a new email for every address in column E, but was only using data from the top row of the range.

Any help would be greatly appreciated as I cannot figure it out.

 

[mrshl9898]

Your Offsets seem to be off and you didn't declare outMail, you'll probably need to adjust more offsets.

Sub EmailBody()

Dim SendTo As String
Dim MailBody As String
Dim objOutlook As Object
Dim outMail As Object

Set objOutlook = CreateObject("Outlook.Application")

For Each i In Range("A2:A100")

MailBody = "Dear " & i.Offset(0, 5) & "," & vbCr & vbCr & i.Offset(0, 6) & vbCr & vbCr & i.Offset(0, 7) & vbCr & vbCr & i.Offset(0, 8) & vbCr & vbCr & "Hospital Number: " & i.Value & vbCr & "Exam Date: " & i.Offset(0, 1) & vbCr & "Exam: " & i.Offset(0, 2) & vbCr & vbCr & "Kind regards," & vbCr & vbCr & i.Offset(0, 11) & vbCr & i.Offset(0, 9) & vbCr & i.Offset(0, 10)

SendTo = i.Offset(0, 4).Value

MsgBox MailBody & vbCr & vbCr & SendTo

Set outMail = objOutlook.CreateItem(olMailItem)

With outMail
.To = SendTo
.Subject = "Images for QA"
.Body = MailBody
.Display
End With

Set outMail = Nothing

Next i

Set objOutlook = Nothing

End Sub

 

[Hoareman]

Thanks mrshl9898

That code worked brilliantly.

Could I add another task to your code? There will not always be data in all the cell in column A. At the moment the code runs, creating blank emails with no addresses.
Is there a code that can be added so once it hits an empty cell in column A, the code stops creating emails.

Thanks

 

[mrshl9898]

This should do it (untested)

VBA Code:
Sub EmailBody()

Dim SendTo As String
Dim MailBody As String
Dim objOutlook As Object
Dim outMail As Object

Set objOutlook = CreateObject("Outlook.Application")

For Each i In Range("A2:A100")

If i.Value = "" then
Exit Sub
End If

MailBody = "Dear " & i.Offset(0, 5) & "," & vbCr & vbCr & i.Offset(0, 6) & vbCr & vbCr & i.Offset(0, 7) & vbCr & vbCr & i.Offset(0, 8) & vbCr & vbCr & "Hospital Number: " & i.Value & vbCr & "Exam Date: " & i.Offset(0, 1) & vbCr & "Exam: " & i.Offset(0, 2) & vbCr & vbCr & "Kind regards," & vbCr & vbCr & i.Offset(0, 11) & vbCr & i.Offset(0, 9) & vbCr & i.Offset(0, 10)

SendTo = i.Offset(0, 4).Value

MsgBox MailBody & vbCr & vbCr & SendTo

Set outMail = objOutlook.CreateItem(olMailItem)

With outMail
.To = SendTo
.Subject = "Images for QA"
.Body = MailBody
.Display
End With

Set outMail = Nothing

Next i

Set objOutlook = Nothing

 

[Hoareman]

Thanks.
This all worked a treat.

 

[mrshl9898]

Glad to hear