我有一个包含列表框的表单。列表框填充表单上的输入数据。
然后,我想将列表框中的所有内容通过电子邮件发送给个人。
以下代码确实有效 - 但它只发送列表框中的第一行。我循环遍历代码,以为它会发送所有列表框
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
答案 0 :(得分:0)
您只循环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