電子郵件列表框內容 - 多個條目

Question

我有一個包含列表框的表單。列表框通過表單上的輸入數據填充。

然後我想將所有列表框的內容通過電子郵件發送給個人。

下面的代碼不起作用 - 但它只發送列表框中的第一行。我正在循環代碼，所以認爲它會發送所有的列表框

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

你只循環選擇語句。不發送電子郵件。試試這個

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