通过电子邮件发送列表框内容-多个条目 [英] emailing listbox content - multiple entries

问题描述

我有一个包含列表框的表单.列表框通过表单上的输入数据进行填充.

I have a form that contains a listbox. The listbox populates through input data on the form.

然后我想通过电子邮件将列表框的所有内容发送给个人.

I then want to email all the contents of the listbox to individuals.

以下代码确实有效-但是它仅发送列表框中的第一行.我正在遍历代码，以为它将发送所有列表框

The following code does work - It does however only send the first line in the listbox. I am looping through the code so thought that it would send all of the listbox

 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

推荐答案

您仅循环执行select语句.没有发送电子邮件.试试这个

You only loop the select statement. Not sending the e-mail. Try this

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

这篇关于通过电子邮件发送列表框内容-多个条目的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！