發送帶有附件和簽名的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

來源

2016-03-15 Muneeb

這不是vb.net是VBscript嗎？請相應地編輯您的標籤。謝謝 –

編輯................. – Muneeb

謝謝。有些人 - 像我一樣。標記標記他們不太瞭解被忽略。其他人只搜索看他們知道的標籤的問題。所以正確的標記可能會幫助你得到答案。 –

如果您使用的是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

來源

2016-03-15 04:07:55 0m3r

此代碼工作正常，但是這封電子郵件是從我的基本外觀帳戶生成的。而不是根據我的「來自代碼」。由於我配置了兩個Outlook帳戶，我想將它發送給我的特定帳戶。 – Muneeb

@ user2317074 sry添加代碼錯誤的地方，我現在已經測試它應該工作，現在看到更新，應該是'使用Mail_Object'設置Mail_Object.SendUsingAccount = App.Session.Accounts.Item（2）' – 0m3r

@ Om3r。 ..它工作...非常感謝您的合作 – Muneeb

發送帶有附件和簽名的Outlook電子郵件

回答

相關問題