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

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

如何在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

---

如果您从MS Excel执行此操作，将更加简单。打开工作簿并将此代码粘贴到模块中（未测试）

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

---

不要设置

CC

属性，而是调用

Recipients。添加
（返回
Recipient
对象）并设置
Recipient。将
属性键入
olCC
发送一封电子邮件？或者每个收件人发送一封电子邮件？为什么要从Outlook执行此操作？从excel中完成这项工作会容易得多。对于该工作簿@Kelaref，不是每个收件人一封邮件。我想同时发送给多个收件人Hi Siddharth，你的代码非常棒。谢谢但是，我的要求是同时将邮件发送到A列的所有单元格。i、 e同时向多个用户发送邮件。那么这就太棒了：）
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

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