excel - 无法使用 VBA 发送电子邮件

Question

我正在使用 VBA 发送电子邮件自动化。当电子邮件发送时，它不会将文件附加到电子邮件。

这是我的一些 VBA 代码：

   Set iMsg = CreateObject("CDO.Message")
   Set iConf = CreateObject("CDO.Configuration")
   Set objFSO = CreateObject("Scripting.FileSystemObject")

       iConf.Load -1    ' CDO Source Defaults
       Set Flds = iConf.Fields
       With Flds
          .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
          .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "10.45.1.25"
          .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
          .Update
       End With
       Dim Result() As String
       Dim xAttaches As String

      Result = Split(WorksheetFunction.Trim(xAttached), "|")

  With iMsg
      Set .Configuration = iConf
      .To = "[e-mail]"
      .CC = 
      .From = "[e-mail]"
      .Subject = xSubject
      .HTMLBody = RangetoHTML(rng) & strBody
       For i = LBound(Result()) To UBound(Result())
         xAttaches = "R:\ASMP\00_AP_AUTO_MAIL\202003\BARCODE\IE238182.pdf"
        If objFSO.FileExists(xAttaches) Then
          iMsg.AddAttachment "R:\ASMP\00_AP_AUTO_MAIL\202003\BARCODE\IE238182.pdf"
        End If
     Next i
      iMsg.Send
  End With

  With Application
      .EnableEvents = True
      .ScreenUpdating = True
  End With

  Set iMsg = Nothing
  Set iConf = Nothing
  Set Flds = Nothing
End Function

我的代码可以运行并且可以发送电子邮件。像这样 ：

但我需要在电子邮件中附加文件。像这样：

请告诉我如何解决这个问题。

标签： excelvbaoutlook

Answer 1

我不知道你为什么使用 CDO.Message。如果您使用 Outlook 发送电子邮件，有一个使用默认 Outlook 对象的简单方法：您只需在 VBA 编辑器 -> 参考中选择“Microsoft Outlook 对象库”；那么您将可以访问所有 Outlook 对象模型。

Sub MailExcelVbaOutlook()
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "[e-mail]" 
        .CC = ""
        .BCC = "" 
        .Subject = "Topic" 
        .HTMLBody = RangetoHTML(rng)
        .Attachments.Add ("C:\file.txt") 
       .Display or .send
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub