mailing via excel vesturen met bijlage

[ewezel]

Goedemiddag beste helpers,

Heb een probleem met het versturen van een bestand met een mailinglijst in excel 2010.
Bijgevoegd zit een excel bestand met in kolom B alle emailadressen (uiteindelijk worden er dat 1500 stuks)
Nu zou via de macro ctrl-s ieder mailadres een aparte mail moeten worden met dezelfde bijlage.

De macro zoekt ook naar het juiste account waarmee verzonden wordt alleen wordt nu niet per adres een mail aangemaakt,
maar dezelfde mail met het laatste mailadres uit kolom B en 6 keer de bijlage in één mail.

zou iemand van jullie hier naar willen kijken kom er niet meer uit.

met vriendelijke groeten erwin

 

[ewezel]

na wat puzzelen 1.5 dag ben ik er zelf uitgekomen hierbij de oplossing.

Sub VerstuurEmail()
    Dim objOl As Outlook.Application
    Dim objMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim objAccount As Outlook.Account

    Set sh = Sheets("blad1")
    Set objOl = Outlook.Application

    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" Then
        
Set objMail = objOl.CreateItem(olMailItem)
    For Each objAccount In objOl.Session.Accounts
        If objAccount.DisplayName = "info@probinkaatsheuvel.nl" Then
            Set objMail.SendUsingAccount = objAccount
        End If
    Next

    With objMail
        .To = cell.Value
        .Subject = "test file"
        .Body = "testen"
        .Attachments.Add "C:\Users\Erwin\Desktop\Brief Probin.pdf"
        .Display
    End With
    End If
    Next cell
    
    Set objMail = Nothing
    Set objOl = Nothing
End Sub