I have a membership database containing about 1600 individuals, and I need to
email them each their membership number. Is it possible to send out all of
the emails at once? For example, I want to send an email to each of the
addresses in column C, addressed "Dear (firstname)", and containing their
membership number from column Q. Can I do that without sending 1600
individual emails?

Thanks...

Yes. For example, name a cell MessageBody, and enter your message, like this:

Hello FirstName,

The LastName Family's membership number is MemberNumber.

Thanks,
Will

Name the cells with the addresses in column C EMailAddresses, and in the first row of your
database, have the headers
FirstName, LastName, and MemberNumber (and any other values that you want to include) somewhere
between column D and column Z.

The macro will check columns D through Z for values, and replace any instance of the header string
within the message with the corresponding value from that column.

So, the message might become, for example,

Hello Bernie,

The Deitrick Family's membership number is 12345A.

Thanks,
Will

The macro requires a reference to MS outlook. Depending on your version, you may need to click once
for every email message. Test it on a small set first, of course....

HTH,
Bernie
MS Excel MVP

Sub EmailRecipient()
Dim ol As Object
Dim myItem As Object
Dim AddCell As Range
Dim myCell As Range
Dim myAttachments As Attachments

Set ol = CreateObject("outlook.application")
For Each AddCell In Range("EMailAddresses")
Set myItem = ol.CreateItem(olMailItem)
myItem.To = AddCell.Value

myItem.Subject = "Membership number...."

myItem.Body = Range("MessageBody").Value
For Each myCell In Range(AddCell(1, 2), AddCell(1, 23))
If myCell.Value < "" Then
myItem.Body = Replace(myItem.Body, Cells(1, myCell.Column), myCell.Value)
Else
GoTo SendMsg:
End If
Next myCell

SendMsg:
'remove this line
Set myAttachments = myItem.Attachments
myAttachments.Add ThisWorkbook.FullName, olByValue
myItem.Send
Next AddCell

Set ol = Nothing
End Sub


"ewill14" wrote in message
...
I have a membership database containing about 1600 individuals, and I need to
email them each their membership number. Is it possible to send out all of
the emails at once? For example, I want to send an email to each of the
addresses in column C, addressed "Dear (firstname)", and containing their
membership number from column Q. Can I do that without sending 1600
individual emails?

Thanks...

I'm sorry, I should have removed these lines:

Set myAttachments = myItem.Attachments
myAttachments.Add ThisWorkbook.FullName, olByValue

HTH,
Bernie
MS Excel MVP


"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Yes. For example, name a cell MessageBody, and enter your message, like this:

Hello FirstName,

The LastName Family's membership number is MemberNumber.

Thanks,
Will

Name the cells with the addresses in column C EMailAddresses, and in the first row of your
database, have the headers
FirstName, LastName, and MemberNumber (and any other values that you want to include) somewhere
between column D and column Z.

The macro will check columns D through Z for values, and replace any instance of the header string
within the message with the corresponding value from that column.

So, the message might become, for example,

Hello Bernie,

The Deitrick Family's membership number is 12345A.

Thanks,
Will

The macro requires a reference to MS outlook. Depending on your version, you may need to click
once for every email message. Test it on a small set first, of course....

HTH,
Bernie
MS Excel MVP

Sub EmailRecipient()
Dim ol As Object
Dim myItem As Object
Dim AddCell As Range
Dim myCell As Range
Dim myAttachments As Attachments

Set ol = CreateObject("outlook.application")
For Each AddCell In Range("EMailAddresses")
Set myItem = ol.CreateItem(olMailItem)
myItem.To = AddCell.Value

myItem.Subject = "Membership number...."

myItem.Body = Range("MessageBody").Value
For Each myCell In Range(AddCell(1, 2), AddCell(1, 23))
If myCell.Value < "" Then
myItem.Body = Replace(myItem.Body, Cells(1, myCell.Column), myCell.Value)
Else
GoTo SendMsg:
End If
Next myCell

SendMsg:
'remove this line
Set myAttachments = myItem.Attachments
myAttachments.Add ThisWorkbook.FullName, olByValue
myItem.Send
Next AddCell

Set ol = Nothing
End Sub


"ewill14" wrote in message
...
I have a membership database containing about 1600 individuals, and I need to
email them each their membership number. Is it possible to send out all of
the emails at once? For example, I want to send an email to each of the
addresses in column C, addressed "Dear (firstname)", and containing their
membership number from column Q. Can I do that without sending 1600
individual emails?

Thanks...

See also my site
http://www.rondebruin.nl/sendmail.htm

Look also at the CDO page (no warnings then)

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"ewill14" wrote in message ...
I have a membership database containing about 1600 individuals, and I need to
email them each their membership number. Is it possible to send out all of
the emails at once? For example, I want to send an email to each of the
addresses in column C, addressed "Dear (firstname)", and containing their
membership number from column Q. Can I do that without sending 1600
individual emails?

Thanks...