E-Mail-Listbox Inhalt - mehrere Einträge

Question

Ich habe ein Formular, das eine Listbox enthält. Die Listbox füllt Eingabedaten auf dem Formular aus.

Ich möchte dann den Inhalt der Listbox an Einzelpersonen per E-Mail senden.

Der folgende Code funktioniert - Er sendet jedoch nur die erste Zeile in der Listbox. Ich bin Schleife durch den Code so dachte, dass es die gesamte Listbox senden würde

Private Sub Command25_Click() 
Dim subject As String, Body As String 
Dim OutApp As Outlook.Application 
Dim OutMail As Outlook.MailItem 

    On Error Resume Next 
    Set OutApp = GetObject(, "Outlook.Application") 
    If OutApp Is Nothing Then 
    Set OutApp = CreateObject("Outlook.Application") 
    End If 
    On Error GoTo 0 

    Set OutMail = OutApp.CreateItem(olMailItem) 

    With OutMail 

    For intCurrentRow = 0 To List22.ListCount - 1 
List22.Selected(intCurrentRow) = True 
Next intCurrentRow 




     .To = Me.Text8 
     .subject = "Test Email" 
     .Body = vbNewLine & vbNewLine & Me.List22.Column(1) & ", " & Me.List22.Column(2) & ", " & Me.List22.Column(3) & ", " & Me.List22.Column(4) & ", " & Me.List22.Column(5) 
     .Send 
     End With 

     Set OutMail = Nothing 
     Set OutApp = Nothing 

    End Sub 

Answer 1

Sie nur die SELECT-Anweisung. Nicht die E-Mail senden. Versuchen Sie diese

Private Sub Command25_Click() 
Dim subject As String, Body As String 
Dim OutApp As Outlook.Application 
Dim OutMail As Outlook.MailItem 

    On Error Resume Next 
    Set OutApp = GetObject(, "Outlook.Application") 
    If OutApp Is Nothing Then 
    Set OutApp = CreateObject("Outlook.Application") 
    End If 
    On Error GoTo 0 

    For intCurrentRow = 0 To List22.ListCount - 1  
    Set OutMail = OutApp.CreateItem(olMailItem) 

    With OutMail 
     List22.Selected(intCurrentRow) = True 

     .To = Me.Text8 
     .subject = "Test Email" 
     .Body = vbNewLine & vbNewLine & Me.List22.Column(1) & ", " & Me.List22.Column(2) & ", " & Me.List22.Column(3) & ", " & Me.List22.Column(4) & ", " & Me.List22.Column(5) 
     .Send 
    End With 
    Next intCurrentRow 

Set OutMail = Nothing 
Set OutApp = Nothing 

End Sub