电子邮件列表框内容 - 多个条目

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