Изменение темы электронной почты сразу после отправки - PullRequest
Новая
       7

Изменение темы электронной почты сразу после отправки

0 голосов
/ 12 февраля 2019

Мне нужно отправлять электронные письма, где тема изменена и сохранена в локальной папке (за пределами 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
...