SHARE
TWEET

Untitled




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
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.