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
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