Generating email using VBA

[Diving_Dan]

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

[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

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]

Try this

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