我需要发送电子邮件,并在其中修改主题并将其保存到本地文件夹(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