Question

The below code works fine for one recipient. How do I send the same mail to multiple recipients.

How to send the attachments and how to send mail to multiple recipients in CC. All the to recipients are placed in column A of xlSht.

  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

Answer 2

不是设置CC属性，而是调用Recipients.Add（返回Recipient个对象）并将Recipient.Type属性设置为olCC。

How to send mail to multiple recipients in outlook in vba

2 个答案: