发送带有附件和签名的Outlook电子邮件

我需要发送附件和签名的Outlook电子邮件。

以下是我的VBA代码。

我收到错误“Transport failedtoconnect server”。 看来，我没有给一个正确的SMTP服务器地址。

此外，我需要写公司标志签名。

Sub Outlook() Dim Mail_Object As Object Dim Config As Object Dim SMTP_Config As Variant Dim Email_Subject, Email_Send_From, Email_Send_To, Email_Cc, Email_Body As String Dim Current_date As Date Current_date = DateValue(Now) Email_Subject = "Daily Pending IMs Report (" & Current_date & ")" Email_Send_From = "[e-mail]" Email_Send_To = "[e-mail]" 'Email_Cc = "[e-mail]" Email_Body = "Dear All," & vbCrLf & "" & vbCrLf & "Kindly find Daily Pending IMs Report in the attached files." Set Mail_Object = CreateObject("CDO.Message") On Error GoTo debugs Set Config = CreateObject("CDO.Configuration") Config.Load -1 Set SMTP_Config = Config.Fields With SMTP_Config .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com" .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587 .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[e-mail]" .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "nnnnnn" .Update End With With Mail_Object Set .Configuration = Config End With 'enter code here Mail_Object.Subject = Email_Subject Mail_Object.From = Email_Send_From Mail_Object.To = Email_Send_To Mail_Object.TextBody = Email_Body Mail_Object.cc = Email_Cc 'Mail_Object.AddAttachment "C:\Pending IMs\Pending IMs.pdf" Mail_Object.Send debugs: If Err.Description <> "" Then MsgBox Err.Description End Sub 

Answer 1

如果你使用Outlook，那么你不需要CDO.Configuration

只需删除所有的configuration，

 '// Code will work on Outlook & Excel 2010 Option Explicit Sub Outlook() Dim olItem As Object ' Outlook MailItem Dim App As Object ' Outlook Application Dim Email_Subject, Email_To, Email_Cc, Email_Body As String Dim Current_date As Date Set App = CreateObject("Outlook.Application") Set olItem = App.CreateItem(olMailItem) ' olMailItem ' // add signature With olItem .Display End With Current_date = DateValue(Now) Email_Subject = "Daily Pending IMs Report (" & Current_date & ")" Email_To = "[e-mail]" Email_Body = "Dear All," & vbCrLf & "" & vbCrLf & "See Report in the attached files." Set olItem.SendUsingAccount = App.Session.Accounts.Item(2) With olItem .Subject = Email_Subject .To = Email_To .HTMLBody = Email_Body & vbCrLf & vbCrLf & .HTMLBody .Attachments.Add ("C:\Temp\file001.pdf") ' update Attachment Path '.Send ' Send directly .Display ' Display it End With ' // Clean up Set olItem = Nothing End Sub 

记住这些代码将在Outlook和Excel上工作

在Outlook 2010上testing