保存从 Excel 发送的 Outlook 电子邮件带附件

问题描述

我正在使用 Excel 文件从共享的 Outlook 收件箱发送个性化电子邮件。 发送电子邮件代码运行良好,但我不知道如何将发送的电子邮件项目(包括附件)保存到本地网络位置(我们称之为“One Drive-User101”)。

现在,我手动将每封发送的电子邮件作为 PDF 保存到本地文件夹,并根据收件人的个性化信息(单元格值)命名。

这最后一点代码将完全自动化任务,所以我迫切需要解决方案!

这是我现在拥有的代码

Sub send()
    
    Dim OutApp      As Object
    Dim OutMail     As Object
    Dim mailBody    As String
    Dim greet       As String
    Dim name        As String
    Dim x           As Integer
    Dim eRow        As Long
    
    eRow = Cells(Rows.Count,15).End(xlUp).Row
    For x = 4 To eRow
        
        If Cells(x,15) = "Ready" Then
            Set OutApp = CreateObject("outlook.application")
            Set OutMail = OutApp.CreateItem(0)
            
            mailBody = ActiveSheet.TextBoxes("confirm").Text
            greet = Cells(x,33).Value
            name = Cells(x,29).Value
            
            mailBody = Replace(mailBody,"Employee_Greeting",greet)
            mailBody = Replace(mailBody,"Employee_Last_Name",name)
            
            With OutMail
                .SentOnBehalfOfName = "oursharedinBox@company.com"
                .To = Cells(x,27).Value
                .CC = Cells(x,26).Value & ";" & Cells(x,23).Value
                .Subject = "Confirmation"
                .HTMLBody = mailBody
                '.Attachments.Add ("C:\Users\OneDrive - User101\Confirmation Letter.pdf")
                .display
                '.Send
                '.SaveAs
                '.PrintOut
            End With
            Set OutMail = nothing
            
            Cells(x,15) = "Prepared"
        End If
        
    Next x
    
    Set OutApp= nothing
    
End Sub

解决方法

暂无找到可以解决该程序问题的有效方法,小编努力寻找整理中!

如果你已经找到好的解决方法,欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@)