Sending Email with Excel

[schelber]

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

 

[Nogslaw]

See if this helps you

http://www.mrexcel.com/board2/viewt...il+array&sid=ab96ce97b6884bf0b0d2b3100c5e1ede

 

[schelber]

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]

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?

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