Sending Email with Excel

schelber

Board Regular
Joined
Oct 22, 2005
Messages
172
I am using the attached code to send an email by macro in excel and it works well:

However does anyone know how to write/modify this such that it will send 1 email to an entire mailing list (i.e. xxx@xxx.com;xxx@xxx.com;.....)

as opposed to 20 or so individual emails??

the code below works by selecting the Email Adresses worksheet and sending indivual emails to every address in column 1....i.e.


Get the email address
Email = Cells(r, 1)


code:

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 SendEMail()
Sheets("Email Addresses").Activate
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double
For r = 2 To 3 'data in rows 2-4
' Get the email address
Email = Cells(r, 1)


' Message subject
Subj = "Specification Alarm"

' Compose the message
Msg = ""
Msg = Msg & "Notification to " & Cells(r, 2) & "," & vbCrLf & vbCrLf
Msg = Msg & "The following parameter is out of specification: "
Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
Msg = Msg & "This is an automated response" & vbCrLf

' Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

' Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
' Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:15"))
Application.SendKeys "%s"
Next r
End Sub
 

Some videos you may like

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

schelber

Board Regular
Joined
Oct 22, 2005
Messages
172
Thanks alot for that .......i didnt see it first time.

Admittedly i am no good with VBA except to play it by ear a little bit.

Does anyone know how this:

ReDim Recipients(1 To n)
Dim Recips As Variant

For i = 1 To n
Recipients(i) = Sheet1.Range("A" & i).Text
Next i

Recips = Recipients



would fit into this:

Sub SendEMail()
Sheets("Email Addresses").Activate
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double
For r = 2 To 3 'data in rows 2-4
' Get the email address
Email = Cells(r, 1)


' Message subject
Subj = "Specification Alarm"

' Compose the message
Msg = ""
Msg = Msg & "Notification to " & Cells(r, 2) & "," & vbCrLf & vbCrLf
Msg = Msg & "The following parameter is out of specification: "
Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
Msg = Msg & "This is an automated response" & vbCrLf

' Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

' Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
' Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:15"))
Application.SendKeys "%s"
Next r
End Sub



such that a multiple mailing list would be created on just one email

I have a worksheet called Email Addresses and the addresses are listed in

Row 1-n: Column A

Thanks alot for help with the code!

Rich
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,047
Office Version
  1. 365
Platform
  1. Windows
Rich

That code won't fit into what you already have as far as I can see anyway.

You appear to be emailing by constructing a hyperlink and then executing it. Is that right?

Code:
Sub SendEMail()
Sheets("Email Addresses").Activate
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As Integer

    For r = 2 To 3 'data in rows 2-4
        ' Get the email addresses
        Email = Email & ";" & Cells(r, 1)
    Next r

    ' Message subject
    Subj = "Specification Alarm"
    
    ' Compose the message
    Msg = ""
    Msg = Msg & "Notification to " & Cells(r, 2) & "," & vbCrLf & vbCrLf
    Msg = Msg & "The following parameter is out of specification: "
    Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
    Msg = Msg & "This is an automated response" & vbCrLf
    
    ' Replace spaces with %20 (hex)
    Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
    Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
    
    ' Replace carriage returns with %0D%0A (hex)
    Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
    ' Create the URL
    URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg
    
    ' Execute the URL (start the email client)
    ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
    
    ' Wait two seconds before sending keystrokes
    Application.Wait (Now + TimeValue("0:00:15"))
    Application.SendKeys "%s"

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,118,058
Messages
5,569,957
Members
412,300
Latest member
Chaneycr
Top