Mail versturen naar geselecteerde personen in listbox

[Doperwt]

Hallo,

Is het mogelijk om een mail te versturen, via Outlook, naar personen op basis van een multi-selectie in een listbox? Ik kan handmatig adressen gaan invullen in .To= "" maar ik zie hier graag de e-mailadressen zien staan die ik heb geselecteerd in de listbox.
De onderstaande code gebruik ik voor het versturen van de mail.

Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

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

    strbody = "Hi," & vbNewLine & vbNewLine & _
              "Please see my comment below:" & vbNewLine & _
              txtComment.Value


    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "NOTIFICATION - Commented on " & Worksheets("Calculations").Range("D4").Value
        .Body = strbody
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

Kan iemand mij een voorzetje geven?

 

[SjonR]

Ik heb dat zelf met een onzichtbare textbox op het formulier gedaan waarbij het e-mailadres via Vlookup wordt ingevuld in deze textbox afhankelijk van je keuze in de listbox. Vervolgens het ik dan bij To: Textbox!.value gezet. Dit werkt voor mij prima, al zal er een mooiere manier zijn.

 

[gast0660]

Probeer

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
[COLOR="#FF0000"]If lbContact.ListIndex <> -1 Then
For i = 0 To lbContact.ListCount - 1
If lbContact.Selected(i) Then
If strTo = vbNullString Then
strTo = lbContact.List(i)
Else
strTo = strTo & "; " & lbContact.List(i)
End If
End If
Next[/COLOR]

    strbody = "Hi," & vbNewLine & vbNewLine & _
              "Please see my comment below:" & vbNewLine & _
               txtComment.Value

    On Error Resume Next
    With OutMail
       [COLOR="#FF0000"] .To = strTo[/COLOR]
        .CC = ""
        .BCC = ""
        .Subject = "NOTIFICATION - Commented on " & Worksheets("Calculations").Range("D4").Value
        .Body = strbody
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End If
Unload Me

 

[Doperwt]

Probeer

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
[COLOR="#FF0000"]If lbContact.ListIndex <> -1 Then
For i = 0 To lbContact.ListCount - 1
If lbContact.Selected(i) Then
If strTo = vbNullString Then
strTo = lbContact.List(i)
Else
strTo = strTo & "; " & lbContact.List(i)
End If
End If
Next[/COLOR]

    strbody = "Hi," & vbNewLine & vbNewLine & _
              "Please see my comment below:" & vbNewLine & _
               txtComment.Value

    On Error Resume Next
    With OutMail
       [COLOR="#FF0000"] .To = strTo[/COLOR]
        .CC = ""
        .BCC = ""
        .Subject = "NOTIFICATION - Commented on " & Worksheets("Calculations").Range("D4").Value
        .Body = strbody
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End If
Unload Me

Perfect, bedankt. De code werkt tot zover dat die in ieder geval mijn Outlook de opdracht geeft om de mail te versturen. Alleen de geadresseerde blijft leeg. Hoe kan ik ervoor zorgen dat deze code de waardes in de vijfde kolom (van de listbox) gebruikt?
@SjonR - Bedankt voor je reactie. Ik ga met bovenstaande code verder stoeien, maar mocht het niet lukken dan geef ik jouw suggestie een kans.

 

[gast0660]

strTo = lbContact.List(i, 4)
Else
strTo = strTo & "; " & lbContact.List(i, 4)

 

[gast0660]

Werkend in uw vb

 

[Doperwt]

Super, het werkt! Ik dank u :thumb:

 

[snb]

   Dim OutApp As Object
    Dim OutMail As Object

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

    Set OutMail = Nothing
    Set OutApp = Nothing

Kun je vervangen door:

    with CreateObject("Outlook.Application").CreateItem(0)
       .to= "..."

      .send
    end with