e-mail to multiple recipients

[Bukol]

Here is a good one:
I have a list of e-mail addresses in one column.
Question one: how do I convert them (it's text) into a hyperlink without having to type every address by hand?
Or question two: How can I automate to send a separate e-mail message to everyone on that list using some text stored in another sheet of that workbook. I dont want to create a group of recipients, but send single messages.
Hans

[Al Chara]

Question 1: Try the following code:

Set rng = Range(Range("A1"), Range("a1").End(xlDown))
For Each cell In rng
ActiveSheet.Hyperlinks.Add Anchor:=cell, Address:="mailto:" & cell.Value
Next

Your email addresses should be in column A, or edit as needed.

[Bukol]

Al,
thanks, works fine.
What about part two of my question, because even with the list of e-mail - hyperlinks now I was hoping to record a macro to send one e-mail at a time - same subject, same text - to every recipient on that list. But the code doesn't record copy and paste done inside the mailer box. (Outlook Express)
Hans

[Al Chara]

Do you want to email the workbook as an attachment?

[Tom Schreiner]

Hi Bukol
This is some code I sent to someone else.
It works on my machine, but he never replied to tell me if it worked for him.

Sub SendMsg()
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromGuid _
"{00062FFF-0000-0000-C000-000000000046}", 9, 0

Dim objOL As New Outlook.Application
Dim objMail As MailItem
Dim SheetName As String
Dim ListColumn As String
Dim FirstRow As Long
Dim Cntr As Long
Dim LastRow As Long

'assumes that all data in this column are valid E-mail addresses
'specify range (Edit the next four assignments to suit)
SheetName = "Sheet1"
ListColumn = 1 'where column A=1,B=2,C=3,ect...
FirstRow = 5
LastRow = 1000 'can be much larger than your actual list

Set objOL = New Outlook.Application

For Cntr = FirstRow To LastRow
If Sheets(SheetName).Cells(Cntr, ListColumn).Value <> "" Then
Set objMail = objOL.CreateItem(olMailItem)
With objMail
.To = Sheets(SheetName).Cells(Cntr, ListColumn).Value
.Subject = "PSRT"
.Body = "This is a page for PSRT. Please call 627-48??"
.Send
End With
Set objMail = Nothing
End If
Next

Set objOL = Nothing
End Sub

Tom

Oops!
Outlook Express!
Don't think this will help you then...
Will leave it anyway...


[ This Message was edited by: TsTom on 2002-04-16 07:59 ]

[Al Chara]

Bukol,

You could also use this, but like Tom said, I don't know if it will work with outlook express:

Sub EmailList()
Dim olApp As Outlook.Application, olMail As Outlook.MailItem
Dim Rng As Range, Cell As Range

Set olApp = New Outlook.Application

Set Rng = Range(Range("A1"), Range("a1").End(xlDown))

For Each Cell In Rng
    Set olMail = olApp.CreateItem(olMailItem)
    olMail.To = Cell.Value
    olMail.Subject = "Insert Subject"
    olMail.Body = "Insert Body"
    olMail.Send
Next

End Sub

The code was adapted from one that was on this board (I think from dk).

[Bukol]

Tom,
on line: "Dim objol As New Outlook.Application "
I get Comiple Error Message: user defined type not defined
Do I have to specify OutlookExpress?
Hans

[Bukol]

Al,
no just some text which is stored on another sheet, so I tried to send the worksheet only, which works fine if I do it manually.
Hans

[Al Chara]

Hans,

I don't think Tom or my code will work with Outlook express. Try the following code, it should work with all email programs:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub SendMail()
Dim Rng As Range, Cell As Range
Dim URL As String, Email As String

Set Rng = Range(Range("A1"), Range("a1").End(xlDown))

For Each Cell In Rng
Email = Cell.Value
URL = "mailto:" & Email & "?subject=" & "Insert Subject" & "&body=" & "Insert Body"
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
MsgBox "Email Sent"
Next
End Sub

[Bukol]

Al,
on line one of your code I get the same error as I get in Tom's code.
Hans