Generating email using VBA

Diving_Dan

Board Regular
Joined
Oct 20, 2019
Messages
77
Hi all it's me again,

I'm using some code from Ron De Bruin's site to generate an email using the following code

Code:
[COLOR=#3366CC]Sub Mail_small_Text_Outlook()[/COLOR][COLOR=black]'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016[/COLOR]
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

strbody = "[h=3][B]Dear Customer[/B][/h]" & _
              "Please visit this website to download the new version.
" & _
              "Let me know if you have problems.
" & _
              "Ron's Excel Page" & _ [COLOR=#3366CC]              "

[B]Thank you[/B]"[/COLOR]    

    On Error Resume Next
    With OutMail
        .To = strto
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = strbody
        [COLOR=black]'You can add a file like this
        '.Attachments.Add ("C:\test.txt")[/COLOR]
        .Display  [COLOR=black] 'or use .Send[/COLOR]
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing [COLOR=#3366CC]End Sub[/COLOR]
He then says;
Send to all E-mail addresses in a range and check if the mail address is correct.
Add the code below to the macro and change the To line to this: .To = strto

Code:
Dim cell As Range
    Dim strto As String
    For Each cell In ThisWorkbook.Sheets("Sheet1").Range("A1:A10")
        If cell.Value Like "?*@?*.?*" Then
            strto = strto & cell.Value & ";"
        End If
    Next cell
    If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)
Where would I need to put this extra code into the first bit of code? Does it all go in one place or does it need splitting and putting in different places?
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
17,972
Office Version
2013
Platform
Windows
Try this

Code:
Sub Mail_small_Text_Outlook() 'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
    Dim OutApp As Object, OutMail As Object
    Dim strbody As String, cell As Range, strto As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

strbody = "Dear Customer" & _
              "Please visit this website to download the new version." & _
              "Let me know if you have problems." & _
                "Thank you"
    For Each cell In Range("A1:A10")'change range to suit
        If cell.Value Like "?*@?*.?*" Then
            strto = strto & cell.Value & ";"
        End If
    Next cell
    If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)

    On Error Resume Next
    With OutMail
        .To = strto
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Display   'or use .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    End Sub
 

Forum statistics

Threads
1,078,314
Messages
5,339,446
Members
399,305
Latest member
msklut

Some videos you may like

This Week's Hot Topics

Top