Untitled

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