excel - 如何在vba中向outlook中的多个收件人发送邮件

Question

下面的代码对于一个收件人来说效果很好。如何将同一封邮件发送给多个收件人。

如何发送附件以及如何在 CC 中向多个收件人发送邮件。 所有收件人都放在 xlSht 的 A 列中。

  All the CC recipients are placed in column B of xlSht.

Sub Sendmail()
                         Dim olItem As Outlook.MailItem
                        Dim xlApp As Excel.Application
                        Dim xlBook As Excel.Workbook
                        Dim xlSht As Excel.Worksheet
                        Dim sPath As String
                        sPath = "sss" \\workbook placed locally

                        Set xlApp = CreateObject("Excel.Application")

                        Set xlBook = xlApp.Workbooks.Open(sPath)

                        Set xlSht = xlBook.Sheets("Sheet1")

                    '   // Create e-mail Item
                        Set olItem = Application.CreateItem(olMailItem)

                        With olItem

                        .To = xlSht.Range("A1")  

                            .CC = xlSht.Range("B1")

                            .subject = "test"
                            .Display
                           .Send

Answer 1

如果您从 MS-Excel 中进行操作，则会简单得多。打开您的工作簿并将此代码粘贴到模块中(未经测试)

Option Explicit

Sub Sample()
    Dim OutApp As Object, OutMail As Object
    Dim ws As Worksheet
    Dim i As Long, lRow As Long

    Set OutApp = CreateObject("Outlook.Application")

    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 1 To lRow
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .To = ws.Range("A" & i).Value
                .Cc = ws.Range("B" & i).Value
                .Subject = "Blah Blah"
                .Body = "Blah Blah"
                .Attachments.Add "C:\Temp\Sample.Txt"

                .Display
            End With
        Next i
    End With
End Sub

如果您仍然想从 MS-Outlook 执行此操作，请尝试类似的操作(未经测试)

Option Explicit

Const xlUp As Long = -4162

Sub Sample()
    Dim oXLApp As Object, oXLWb As Object, oXLWs As Object
    Dim i As Long, lRow As Long
    Dim olItem As Outlook.MailItem

    Set oXLApp = CreateObject("Excel.Application")
    Set oXLWb = oXLApp.Workbooks.Open("C:\MyExcelFile.Xlsx")
    Set oXLWs = oXLWb.Sheets("Sheet1")

    With oXLWs
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 1 To lRow
            Set olItem = Application.CreateItem(olMailItem)

            With olItem
                .To = oXLWs.Range("A" & i).Value
                .Cc = oXLWs.Range("B" & i).Value
                .Subject = "Blah Blah"
                .Body = "Blah Blah"
                .Attachments.Add "C:\Temp\Sample.Txt"

                .Display
            End With
        Next i
    End With
End Sub