Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
Add Comment
Please, Sign In to add comment