Используя Outlook 2016 VBA, сохраняйте вложение при отправке с использованием SMTP / CDO

Question

Я бы не хотел сохранять вложение из исходного сообщения Outlook на локальный диск, а затем снова присоединять его к сообщению SMTP.Тело сообщения воссоздается для сообщения SMTP, которое работает нормально.

Sub ForwardEmail(myEmail As Outlook.MailItem) 'subroutine called from Outlook rule, when new incoming email message arrives
Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x0076001E"
Set objSMTPMail = CreateObject("CDO.Message") 'needed to send SMTP mail
Set objConf = CreateObject("CDO.Configuration") 'needed for SMTP configuration

Set objFlds = objConf.Fields 'used for SMTP configuration

'Set various parameters and properties of CDO object

objFlds.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2     
objFlds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtpout.test.com" 'define SMTP server
objFlds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 'default port for email

objFlds.Update

objSMTPMail.Configuration = objConf

If myEmail.SenderEmailType = "EX" Then
  objSMTPMail.From = myEmail.Sender.GetExchangeUser.PrimarySmtpAddress
Else
  objSMTPMail.From = myEmail.SenderEmailAddress 'takes email address from   the original email and uses it in the new SMTP email
 objAttachments = myEmail.Attachments  ' I believe this is how to get the attachments

End If

objSMTPMail.Subject = myEmail.Subject 'use the subject from the original email message for the SMTP message
objSMTPMail.HTMLBody = myEmail.HTMLBody 'myEmail.HTMLBody is necessary to retain Electronic Inquiry Form formatting
objSMTPMail.To = "nobody@test.com"
objSMTPMail.AddAttachment objAttachments ' tried to add attachment
'send the SMTP message via the SMTP server
objSMTPMail.Send




'Set all objects to nothing after sending the email

Set objFlds = Nothing
Set objConf = Nothing
Set objSMTPMail = Nothing

End Sub

Answer 1

Вот мое решение.Это работает для моей ситуации.

Sub ForwardEmail(myEmail As Outlook.MailItem) 'subroutine called from Outlook rule, when new incoming email message arrives

On Error GoTo Resetvar
Set objSMTPMail = CreateObject("CDO.Message") 'needed to send SMTP mail
Set objConf = CreateObject("CDO.Configuration") 'needed for SMTP configuration

Set objFlds = objConf.Fields 'used for SMTP configuration

'Set various parameters and properties of CDO object

objFlds.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'cdoSendUsingPort
objFlds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtpout.test.com" 'define SMTP server
objFlds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 'default port for email

objFlds.Update

objSMTPMail.Configuration = objConf

'EX value is an Exchange mailbox locally
If myEmail.SenderEmailType = "EX" Then
    objSMTPMail.From = myEmail.Sender.GetExchangeUser.PrimarySmtpAddress
Else
    objSMTPMail.From = myEmail.SenderEmailAddress 'takes email address from the original email and uses it in the new SMTP email
End If
Dim i As Integer
i = -1
Dim arrAtmt() As String
Dim FileName As String
For Each Atmt In myEmail.Attachments
    FileName = "C:\temp\" & myEmail.EntryID & "." & Atmt.FileName
    Atmt.SaveAsFile FileName
    i = i + 1
    ReDim Preserve arrAtmt(i)
    arrAtmt(i) = FileName
Next Atmt

    objSMTPMail.Subject = myEmail.Subject 'use the subject from the original email message for the SMTP message
    objSMTPMail.HTMLBody = myEmail.HTMLBody 'myEmail.HTMLBody is necessary to retain Electronic Inquiry Form formatting
    objSMTPMail.To = "mary@test.com"

    If i > -1 Then
        For counter = 0 To i
            objSMTPMail.AddAttachment arrAtmt(counter)
        Next
    End If
    objSMTPMail.Send

Erase arrAtmt

Resetvar:

Set objFlds = Nothing
Set objConf = Nothing
Set objSMTPMail = Nothing

End Sub