CODEWITHSUNDEEP
excelvbaloopsemailattachment
smartini
smartini

Reputation: 455

(VBA) Send Mails with multiple attachements, duplicate mail addresses in list

I have an Excel Sheet (let's call it "Sheet2") with let's say 200 Names in column [A] and the attachement for the Name in the column next to it [B].

There is another Sheet ("Sheet1") with the mail addresses for each Name. Important! -> This Sheet1-list is longer than the first list with the 200 Names.

It appears, that there are duplicate entries in the Sheet "Sheet2" (column [A]) but with different attachments.

I would like to only send out one mail with all necessary attachements for a user, somehow I cannot manage to do so...

The loop I got creates mails for every user in the list "Sheet1", but I only need mails for the users in list "Sheet2".

Hope to find an answer here. Thanks!

My code:

Sub Mails()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


Dim FileName As Variant
Dim wkbSource As Workbook
Dim wksSource As Worksheet
Dim wksDest As Worksheet


Set wksDest = ThisWorkbook.Worksheets("Sheet2")
Set wksSource = ThisWorkbook.Worksheets("Sheet1")

Dim LastRowSource As Long
LastRowSource = wksSource.Cells(wksSource.Rows.Count, "A").End(xlUp).Row

Dim LastRowDest As Long
LastRowDest = wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Row

For i = 1 To LastRowSource

    Dim OutApp As Object
    Dim OutMail As Object
    Dim CC As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Dim TC_User As String
    Dim TC_Attachement As String
    Dim TC_File As String

    TC_User = ""
    CC = ""
    TC_User = wksSource.Range("A" & i)
    TC_USer_mail = wksSource.Range("B" & i)
    TC_Attachement = ""

        With OutMail
            .To = TC_USer_mail
            .BCC = ""
            .Importance = 2
            .Subject = "for you"
            .HTMLBody = "<body style='font-family:arial;font-size:13'>" & _
                        "<b>############################################<br>" & _
                        "Diese Mail wurde automatisch erstellt<br>" & _
                        "############################################</b><br><br>" & _
                            "Hallo " & TC_User & "," & "<br><br>" & _
                            "blabla.<br><br>" & _
                        "</body>"
            For g = 2 To LastRowDest
                If wksDest.Range("A" & g) = TC_User Then

                    TC_File = wksDest.Range("B" & g)
                    TC_Attachement = "C:\Users\bla\Documents" & "\" & TC_File

                    If Dir(TC_Attachement) <> "" Then
                        .Attachments.Add TC_Attachement
                        'GoTo nextvar

                        Else
                    End If
                End If
'nextvar:
            Next g

        .Display
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
Next i

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Ende:

End Sub

Upvotes: 0

Views: 272

Answers (2)

smartini
smartini

Reputation: 455

Ok, I found my solution. Maybe it's not that elegant, but it works. I wrote this code right before the "With OutMail" - Statement. This will check whether the User-ID from the mail database is actually in the list with the receipients, if not this User-ID will be skiped.

    For j = 2 To LastRowSource
        If TC_User = wksDest.Range("A" & j) Then
            GoTo weiter_j
        End If
    Next j
GoTo Ende:

weiter_j:

Upvotes: 1

ashleedawg
ashleedawg

Reputation: 21639

So there are a unknown number of attachments for each name (ie., not necessarily one) and you need them grouped together? (and it sounds like a one-time thing?)

Just copy and paste one table below the other so that the name columns lines up, and then simply go Sort the list (Data → Sort) and then the names will be grouped together.

From here there are a few ways you could arrange the list to automate the sending process. By the sounds of it, most of the names have one attachment, so send those like you were going to, and send the additional ones manually.

Handling a one-off task manually can often be quicker and easier than trying to automate it.

If this is going to be a recurring task, then try to find a better way to organize the source data (like a simple Access table.)

Upvotes: 0

Related Questions