Excel VBA发送后删除电子邮件

时间:2018-11-14 08:20:18

标签: excel vba outlook

也许您可以在VBA代码方面为我提供帮助。

我得到了一个代码,该代码作为Excel工作表的PDF部分发送。 问题是电子邮件被很多人使用,有时文本是机密的。发送电子邮件后,是否可以删除电子邮件(已发送邮件和已删除邮件)?

使用office 2000

这是我现有的代码。

Sub SendDDocs()
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
  Dim rng As Range
  Set rng = Range("A1:J103")

  Title = Range("o1")


  Title = Range("o1").Value & " Confidetial"
  PdfFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Title & ".pdf"

  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

  With OutlApp.CreateItem(0)

    .Subject = Title
    .To = "email@email.com"
    .CC = "email@email.com"
    .Body = "" & vbLf & vbLf _
          & "a" & vbLf & vbLf _
          & "" & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile

    Application.Visible = True
    .Display
  End With

Kill PdfFile

  If IsCreated Then OutlApp.Quit

  Set OutlApp = Nothing

End Sub

1 个答案:

答案 0 :(得分:0)

代替.Display使用

.DeleteAfterSubmit = True
.Send

不将副本保存在已发送的邮件中。

请参见MailItem.DeleteAfterSubmit Property (Outlook)