发送带有附件和签名的Outlook电子邮件
问题描述:
我需要发送带有附件和签名的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 = "[email protected]"
Email_Send_To = "[email protected]"
'Email_Cc = "[email protected]"
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") = "[email protected]"
.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
答
如果您使用的是Outlook,那么你不必CDO.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 = "[email protected]"
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 2上测试010
这不是vb.net是VBscript吗?请相应地编辑您的标签。谢谢 –
编辑................. – Muneeb
谢谢。有些人 - 像我一样。标记标记他们不太了解被忽略。其他人只搜索看他们知道的标签的问题。所以正确的标记可能会帮助你得到答案。 –