发送后立即修改电子邮件主题

时间:2019-02-12 00:59:45

标签: outlook-vba

我需要发送电子邮件,并在其中修改主题并将其保存到本地文件夹(Outlook外部)。然后,需要使用原始文件名发送电子邮件(我已经采取了措施),但是发送后,我需要立即在名称后附加(Efiled)。我可以在发送之前使用以下代码来执行此操作,但理想情况下,要发送然后立即附加。

Public xFlag As Boolean
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objSent As Outlook.MAPIFolder
Dim oMail As Outlook.mailItem
Dim prompt As String
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
Dim emailto As String

Dim MsgColl As Object
Dim msg As Outlook.mailItem
Dim objNS As Outlook.NameSpace
Dim i As Long
Dim subjectname As String



Set objNS = Application.GetNamespace("MAPI")
Set objSentItems = objNS.GetDefaultFolder(olFolderSentMail).Items
Set objNS = Nothing

prompt = "Are you sure you want to send " & Item.Subject & "?"
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
Cancel = True
End If

enviro = CStr(Environ("USERPROFILE"))
Original = Item.Subject
sName = Item.Subject
'MsgBox sName
'ReplaceCharsForFileName sName, "-"

 dtDate = Item.ReceivedTime

 emailto = Item




 sName = Format(dtDate, "yyyy-mm-dd", vbUseSystemDayOfWeek, _
vbUseSystem) & " (Out) '" & sName & "' " & Format(dtDate, " (hh-nn-ss)", _
vbUseSystemDayOfWeek, vbUseSystem) & " (" & emailto & ").msg"

'MsgBox sName



sPath = "d:\efilecabinet-email\"

On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
         ' a collection of selected items
        Set MsgColl = ActiveExplorer.Selection
    Case "Inspector"
         ' only one item was selected
        Set msg = ActiveInspector.CurrentItem
End Select
On Error GoTo 0

If (MsgColl Is Nothing) And (msg Is Nothing) Then
    GoTo ExitProc
End If


If Not MsgColl Is Nothing Then
    For i = 1 To MsgColl.Count
         ' set an obj reference to each mail item so we can move it
        Set msg = MsgColl.Item(i)
        With msg
            .Subject = sName & " (Efiled)"
            .Save
        End With
    Next i
ElseIf Not msg Is Nothing Then
    msg.Subject = sName & " (Efiled)"
End If

ExitProc:

Set msg = Nothing
Set MsgColl = Nothing
'Set olMyFldr = Nothing
Set objNS = Nothing

'Set oSel = Application.ActiveExplorer.Selection
'For Each oMail In oSel
'Item.Categories = "Bookkeeping"
'Item.Save

Debug.Print sPath & sName
Item.SaveAs sPath & sName, olMSG

'MsgBox Original


Item.Subject = Original & " (Efiled)"
End Sub

0 个答案:

没有答案