CODEWITHSUNDEEP
vbaemailexcel
Annux3
Annux3

Reputation: 1

VBA code to send personalized email from excel

I would like to have a code that will send emails using excel table as source. email addresses are in the table, however they are duplicates.

I found a code that generates and email for every row/line, but i need it to generate an email for multiple rows that contain same email address.

PLEASE! Modify the code so that it will generate only 1 email from multiple rows that contain same email address.
*I would do it myself but i do not know how because i do not know how to code in VBA.

The code i have so far is and it generates email for EVERY line, which is not what i am looking for:

Sub email()
Dim i As Long
Dim OutApp, OutMail As Object
Dim strto, strcc, strbcc, strsub, strbody As String

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

For i = 1 To Range("c65536").End(xlUp).Row
Set OutMail = OutApp.CreateItem(0)

    strto = Cells(i, 8)
    strsub = "Missing Books"
    strbody = "Good day," & vbNewLine & _
        "We are missing below books:" & vbNewLine & _
        Cells(i, 1) & Chr(32) & Cells(i, 2) & Cells(i, 3) & Cells(i, 5) & Cells(i, 6) & vbNewLine & vbNewLine & _
        "brgds," & vbNewLine & _
        "Alex"

    With OutMail
        .To = strto
        .Subject = strsub
        .Body = strbody
        '.Send
        .display

    End With
    On Error Resume Next

Next

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

The final email for email address should look like this:

to: [email protected]
subject: Report!
Hello!

Here is the overview of the used service:

Period / Number / Company/ Count / Duration * header row
201504 / 900654 / ETV / 5 / 89 / * data row, includes email in column H
201504 / 900098 / ETV / 2 / 24 / * data row, includes email in column H

Best wishes, Annu

NOTE: First row is the header row and starting from second row are the data cells. They come from a table as does the emails
NOTE: H is the Column for emails - there can be 10 times/lines [email protected] and it needs only 1 email but with the information that comes prior the email cell itself.

Edit* This is the table

Upvotes: 0

Views: 2515

Answers (1)

Dubison
Dubison

Reputation: 768

Please see below to make a string with each row in a column, code will neglect repeating data, then you can use that string in your mailto variable:

enter image description here

Sub uniqueSTR()
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim mailSTR As String

Set wb = ActiveWorkbook 'Your workbook
Set ws = wb.Sheets("Sheet2") 'Your sheet name

lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row


For i = 1 To lastRow
    If InStr(mailSTR, Range("A" & i).Value) = 0 Then
        If mailSTR = "" Then
            mailSTR = Range("A" & i).Value
        Else
            mailSTR = mailSTR & ";" & Range("A" & i).Value '<- Mail seperator is ";"
        End If
    End If
Next

Range("B1").Value = mailSTR '<- Your result

End Sub

Upvotes: 1

Related Questions