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

您只循环select语句。不发送电子邮件。试试这个

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

通过电子邮件发送列表框内容 - 多个条目

1 个答案: