mailen naar mailadressen in cell

[Roncancio]

Zo?

Sub Knop146_BijKlikken()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim sAan As String

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    
    On Error GoTo cleanup
    For Each cell In Worksheets("evenement").Columns("M").Cells.SpecialCells(xlCellTypeFormulas)
        If (Worksheets("evenement").Cells(cell.Row, "M").Text) Like "?*@?*.?*" And LCase(Worksheets("evenement").Cells(cell.Row, "N").Text) = "ja" Then
            sAan = sAan & Worksheets("evenement").Range("M" & cell.Row).Value & ";"
        End If
    Next cell
    
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = sAan
        .Subject = "Reminder"
        .Body = "Please contact us to discuss bringing your account up to date"
        .Send
    End With
    Set OutMail = Nothing
    
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Met vriendelijke groet,


Roncancio

 

[descheep]

:thumb::thumb::thumb::thumb:



helemaal goed, waarvoor vriendelijk dank Roncancio

 

[Roncancio]

:thumb::thumb::thumb::thumb:



helemaal goed, waarvoor vriendelijk dank Roncancio

Graag gedaan.
Graag nog even de vraag op opgelost zetten.
Bvd.

Met vriendelijke groet,


Roncancio

 

[descheep]

ik was al op zoek ;-)