William
William

Reputation: 115

Adding conditions and optional input to an e-mail sending macro

I have a slight issue with a macro. It works fine at the moment, but I need to add some code to do the following but don't know at what point to add it:

  1. If for each cell in Column C that there is a blank cell to look for the email address on the same row but 10 columns over to the right in Column M

  2. In the start of the body "Hi There (Column B content)

  3. In the body of the email I would like for the macro to insert the contents from column F like this: "Please choose the following option (Column F content)

Any Ideas on how I can modify the code to include these options please.

Thank you for your time.

Sub Send_Email()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim cel As Range
    Dim SigString As String
    Dim Signature As String

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

 SigString = Environ("appdata") & _
                "\Microsoft\Signatures\GBS.txt"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    For Each cel In Range(("C2"), Range("C2").End(xlDown))
        strbody = "Hi there" & vbNewLine & vbNewLine & _
                "My name Is William, Please choose the following option ..." & vbNewLine & _
                "I work at Fair" & vbNewLine & _
                "Bye" & vbNewLine & _
                "WH"

        On Error Resume Next
        With OutMail
            .To = cel.Value
            .CC = cel.Offset(0, 10).Value
            '.BCC = ""
            .Subject = "Choose you plan"
            .Body = strbody & vbNewLine & vbNewLine & Signature
            .Display
            '.Attachments.Add ("C:\test.txt")
            '.Send
        End With
        On Error GoTo 0
    Next cel

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Upvotes: 1

Views: 144

Answers (1)

Dmitry Pavliv
Dmitry Pavliv

Reputation: 35853

Try this one:

Sub Send_Email()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim cel As Range
    Dim SigString As String
    Dim Signature As String
    Dim lastrow As Long
    Set OutApp = CreateObject("Outlook.Application")


    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\GBS.txt"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    lastrow = Cells(Rows.Count, 3).End(xlUp).Row

    For Each cel In Range("C2:C" & lastrow)
        strbody = "Hi there" & cel.Offset(, -1) & vbNewLine & vbNewLine & _
                "My name Is William, Please choose the following option ..." & vbNewLine & _
                cel.Offset(, 3) & _
                "I work at Fair" & vbNewLine & _
                "Bye" & vbNewLine & _
                "WH"

        On Error Resume Next
        With OutApp.CreateItem(0)
            If cel.Value <> "" Then
               .To = cel.Value
               .CC = cel.Offset(0, 10).Value
            Else
               .To = cel.Offset(0, 10).Value & ", " & Join(Application.Index(cel.Offset(, -2).Resize(, 4).Value, 0), ", ")
            End If
            '.BCC = ""
            .Subject = "Choose you plan"
            .Body = strbody & vbNewLine & vbNewLine & Signature
            .Display
            '.Attachments.Add ("C:\test.txt")
            '.Send
        End With
        On Error GoTo 0
    Next cel


    Set OutApp = Nothing
End Sub

Upvotes: 3

Related Questions