编辑,发送和保存电子邮件到文件系统

时间:2017-03-24 05:03:10

标签: vba excel-vba excel

我们目前有一个由Excel使用VBA自动创建的电子邮件,主题,收件人,邮件正文都填写了模板文本。

Sub CreateMail(Optional sFile As String = "")
'Create email to send to requestor with attachment sFile

'Declarations
    Dim app As Outlook.Application
    Dim msg As Outlook.MailItem
    Dim send_to As Recipient
    Dim send_tos As Recipients

'Initiations
    Set app = CreateObject("Outlook.Application")
    Set msg = app.CreateItem(olMailItem)
    Set send_tos = msg.Recipients
    Set send_to = send_tos.Add("receiver@email.com")
    send_to.Type = 1

'Create message
    With msg
        .SentOnBehalfOfName = "sender@email.com"
        .Subject = "This is the email subject"
        .HTMLBody = "This is the email body" & vbCrLf
        'Resolve each Recipient's name.
            For Each send_to In msg.Recipients
              send_to.Resolve
            Next
        If Len(sFile) > 0 Then
            .Attachments.Add sFile
        End If
        .Display
    End With

End sub

在对创建的电子邮件进行一些手动更改后,我们希望将其发送并自动将副本保存到文件系统上的文件夹中(除了Outlook中常用的已发送文件夹)。有没有办法在Excel VBA中完成所有操作?

我怀疑使用Outlook VBA是可能的,但文件夹是在Excel中定义的,我们希望将代码保存在一个文件中。

2 个答案:

答案 0 :(得分:0)

您发送电子邮件的代码是什么?这适用于Excel VBA模块:

Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
    .BodyFormat = olFormatRichText
    .To = "email address"
    .Subject = "Test"
    .HTMLBody = "Test " & Now
    .DeleteAfterSubmit = True 'to not retain in sent folder
    .Display
    .SaveAs "C:\filepath\Test.txt", 0
'    .Send
End With

然而,猜测真正的诀窍是允许在保存文件之前编辑电子邮件。到目前为止还没有找到解决方案。不幸的是,在消息窗口打开时,代码执行不会暂停。我希望暂停,因为Office应该是一个集成的应用程序套件 - 比如在对话框模式下在Access中打开一个表单,它会暂停执行代码。

答案 1 :(得分:0)

仅使用Excel中的代码,监控SentItems文件夹。

Utilizing Outlook Events From Excel

使用唯一ID确认邮件。

唯一ID可以在主题或正文中。

您可以尝试在PR_SEARCH_KEY中保存唯一ID。这个想法是How, can get the exact sent Email from Sent Items folder?How to uniquely identify an Outlook email as MailItem.EntryID changes when email is moved