Question

我正在尝试创建电子邮件，并基于列表框填充多个收件人。我整理的代码无法正常工作。有人知道代码的问题吗？

我尝试将列表框列引用放在“ .To”行中，但它给出了空错误。然后，我找到了一些应该遍历列表框值的代码，但没有填充任何收件人。我的VBA知识有限，因此我可能使用了错误的循环代码。

Public Sub cmdEmailContact_Click()

    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
    Dim strPath As String
    Dim strFilter As String
    Dim strFile As String
    Dim strFileEnd  As String
    Dim strEmailRecipients As String

    strPath = "C:\Users\username\Desktop\Invoice Test\GCX"
    strFilter = Me.txtInvNum
    strFileEnd = ".pdf"
    strFile = Dir(strPath & strFilter & strFileEnd)
    strEmailRecipients = ""
      For N = 0 To Me.lstContacts.ListCount - 1
         If Me.lstContacts.Selected(N) = True Then
            strEmailRecipients = strEmailRecipients & "; " & Me.lstContacts.Column(3, N)   
         End If
      Next N
    strEmailRecipients = Mid(strEmailRecipients, 3)

    If strFile <> "" Then

        Set appOutLook = CreateObject("Outlook.Application")
        Set MailOutLook = appOutLook.CreateItem(olMailItem)

        With MailOutLook
            .BodyFormat = olFormatRichText
            .To = strEmailRecipients
            ''.cc = ""
            ''.bcc = ""
            .Subject = "text here"
            .SentOnBehalfOfName = "emailname"
            .HTMLBody = "text here"
            .Attachments.Add (strPath & strFilter & strFileEnd)
            '.Send
            .Display 
        End With
    Else
        MsgBox "No file matching " & strPath & strFilter & strFileEnd & " found." & vbCrLf & _
                "Process has been stopped."
        Exit Sub   
    End If

End Sub

我期望strEmailRecipients等于以分号分隔的电子邮件列表（基于列表框），但不会在生成的电子邮件中填充任何内容。没有错误消息。

Answer 1

您可能不希望构建以分号分隔的字符串来填充To对象的MailItem属性，而可以在添加收件人时修改Recipients集合的内容（独立于收件人类型）到MailItem对象。

使用Recipients方法将一个项目添加到Add集合中将产生一个Recipient对象，该对象具有一个Type属性，可用于将接收者指定为通过将属性设置为olTo，olCC或olBCC（或1，2或3如果使用后期绑定）。

因此，电子邮件的构造可能类似于以下内容：

Dim idx
With MailOutLook
    With .Recipients
        For Each idx In lstContacts.ItemsSelected
            With .Add(lstContacts.ItemData(idx))
                .type = olTo
                .Address = lstContacts.ItemData(idx)
            End With
        Next idx
    End With
    .BodyFormat = olFormatRichText
    ' ... etc.
End With

从列表框值创建具有多个收件人的电子邮件

1 个答案: