Sending emails with Addressed attachments

[simora]

I had previously posted this in an Excel forum here
http://www.vbaexpress.com/forum/showthread.php?47307-Sending-emails-with-attachments-from-excel

and I got no responses. A colleague suggested that I re-post here.

I have a worksheet with 8 used columns A - H (Using Office 2003 & Win XP )
The columns that I want to use are;

Column A - Salutation
Column B - Last Name
Column D - eMail Address
Cell H1 is the Subject

I'm trying to get a VBA macro to email everyone in Column D a copy of an attachment.
The attachment is a Ms Word.doc file sitting on my desktop . ( I can put it into a folder if needed )

When I run the macro, Outlook tells me that it doesn't recognize one or more names.

How can I have the body of the email say " Dear < Salutation> . <Lastname> Please see attached document "

And have the attachment sent to everyone in Column D.

Is it also possible to have the attachment customized and addressed to each client with their name reflected in the attachment? If so, how ?

I'm new to using Outlook, so details may be in order . If I have to, I can use Office 2007 if that simplifies things in any way. I was hoping to be able to run the macro from excel because I understand that environment.

Attached is the worksheet I'm using.
Thanks.

[skatonni]

This as an example for Excel. Add code to loop through all rows of data.

http://www.vbaexpress.com/forum/showthread.php?45948-Populate-a-form-based-email-using-cells-from-an-excel-workbook



Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim Strbody As String

Application.ScreenUpdating = False

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

' the Range("").value is where you have the data that you need to be 'entered.
Strbody = "Dear " & Range("A1").Value & vbCr & vbCr
Strbody = Strbody & "Your equipment has Fredbeen shipped." & vbCr
Strbody = Strbody & "You will soon be contacted by of of our " & vbCr
Strbody = Strbody & "Please call us at (####)." & vbCr & vbCr
Strbody = Strbody & "Kinds and Regards." & vbCr & vbCr
Strbody = Strbody & "Matt"


On Error Resume Next
With OutMail
.To = Range("B9").Value
.CC = Range("B20").Value
.Subject = "Shipment Confirmation" & Range("B3").Value
.Body = Strbody
.Display 'or used .send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub


As well you will need something like


.Attachments.Add "C:\MyFile.doc"

[simora]

Thanks:

Now Outlook has quit and refuses to send mail. What I was asking is if there was a way to personalize the attachment itself while doing the mail merge.
However, I will test it later.

[Charlize]

Are you using this with a corporate server (work) or via your private provider. The automatic send will not work because you have a timed security box in outlook. There is a way to use the cdo protocal but microsoft sometimes shuts there server off (so you get an error when sending). Wait an hour or two to try again. The cdo way can bypass the security question.
This is a bit coding off the bat. Don't shoot if not working properly from the first time. And you have to read through the code to change some info that's needed to get this going.

Option Explicit
Option Compare Text
Sub Mail_via_CDO()
'the message
Dim iMsg As Object
'configuration stuff
Dim iConf As Object
'fields
Dim Flds As Variant
'a cell
Dim cell As Range
'no of requests in sheet
Dim v_no_mails As Long
'info after sending mails
Dim v_message As String

v_message = "Mails were sent" & vbCrLf & "No. mails : " & _
vbCrLf & vbCrLf
'if no mailaddress in d2, macro won't run
If Worksheets("Sheet1").Range("D2").Value <> vbNullString Then
'for each address in column D
For Each cell In Worksheets("Sheet1").Range("D2:D" & _
Worksheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row)
'if no subject filled in, this line will make no mail
'and skip to next row
If cell.Offset(, 4).Value <> vbNullString Then
'create the cdo stuff
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

'If you get an error with the sending argument you have to remove the ' of
'Dim Flds As Variant and the coding between the ***
'************
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
'I guess 2 else look up at microsoft site for info at cdo stuff
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'the info your provider gave for sending mail
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
"yourprovider.smtp.stuff"
'normally 25, gmail uses something else, look up at google or provider site
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
'************
'Send an email
With iMsg
Set .Configuration = iConf
'change this to real stuff !!!
.From = """Your name"" <youraddress@yourprovider.com>"
'the address of receiver
.to = cell.Value
.textbody = "Weekly rapport" & vbCrLf & vbCrLf & _
"Your name" & vbNewLine & _
"2nd line of signature"

'.Cc = "xx@xx.com"
.subject = cell.Offset(, 4).Value
'Don't remove TextBody. The attachments can not be opened when received.
'Bug in CDO
'if you want attachment, use next line with proper parameters
'.addattachment
v_message = v_message & "- " & cell.Value & cell.Offset(, 4).Value & _
vbCrLf
.Send
'2nd time because cdo doesn't make a sent item so sent it to yourself
.to = "youraddress@yourprovider.com"
'and send it to yourself
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
v_no_mails = v_no_mails + 1
End If
Next cell
If v_no_mails > 0 Then
MsgBox v_message & vbCrLf & "Total : " & v_no_mails, vbInformation
Else
MsgBox "No mails have been sent.", vbInformation
End If
End If
End Sub