Option Explicit

Global fromEmails As String
Global logAttempts As String
Global filePrefix As String
Global defaultLocation As String
'Based on an idea by Shantanu Goel
'Expanded, solidified and coded by LEarnest 5/2/2008
Private Sub SetOptions()
'********************************************************************
'*  Created on 5/2/08
'*  Created by LEarnest
'*  Purpose: set adjustable parameters
'*  Modification History
'*-------------------------------------------------------------------
'*  Date        Who     Description
'*  20080502        LEarnest       Creation
'********************************************************************


'Email addresses you will accept requess from, semi-colon ';' delimited
'Example: test@test.com;user@user.com;
fromEmails = "insert_the_email@YouWishToRecieveFrom.com;"

'Indicator if you want the attempts logged
'Example: logAttempts = true or logAttempts = false
logAttempts = False

'text at the start of a line in the body to indicate if this is a file request
'Example: "smf:"
filePrefix = "file:"

'default location if the full path is not given
'example: c:\documents and settings\testuser\my documents
defaultLocation = "C:\To Transfer\"
End Sub
Sub testSendMyFiles()
'********************************************************************
'*  Created on 5/2/08
'*  Created by LEarnest
'*  Purpose: A way to interactively test the macro with the top item in the Inbox
'*  Modification History
'*-------------------------------------------------------------------
'*  Date        Who     Description
'*  20080502        LEarnest       Creation
'********************************************************************

    Dim oMI As Outlook.MailItem
    Set oMI = Application.GetNamespace("MAPI").Session.GetDefaultFolder(olFolderInbox).Items.GetFirst
    SendMyFiles oMI
    
End Sub
Sub SendMyFiles(oMailItem As MailItem)
'********************************************************************
'*  Created on 5/2/08
'*  Created by LEarnest
'*
'*  Modification History
'*-------------------------------------------------------------------
'*  Date        Who     Description
'*  20080502    LEarnest       Creation
'********************************************************************
On Error GoTo ErrHandler
'set user options
SetOptions

'declarations and initialization
Dim oNS As Outlook.nameSpace
Dim oMI As Outlook.MailItem
Dim oNote As Outlook.NoteItem
Dim fnRet As Boolean

Set oNS = Application.GetNamespace("MAPI")
Set oMI = oNS.GetItemFromID(oMailItem.EntryID)
Set oNote = oNS.Application.CreateItem(olNoteItem)

'log attempt start
LogNote oNote, "Send File Attempt Started"

'check to see if the email came from an allowed email address
If InStr(fromEmails, oMI.SenderEmailAddress) > 0 Then
    ProcessRequest oMI.Body, oMI.SenderEmailAddress, oNote
Else
    LogNote oNote, ("Unable to process request from " & oMI.SenderEmailAddress)
End If

'log attempt end
LogNote oNote, "Attempt Ended"

If logAttempts = False Then
    oNote.Delete
Else
    oNote.Save
End If

Exit Sub

ErrHandler:
MsgBox "Unable to process File Request: error " & Err.Description, vbOKOnly

End Sub
Private Sub ProcessRequest(sBody As String, sRecipient As String, oNote As NoteItem)
'********************************************************************
'*  Created on 5/2/08
'*  Created by LEarnest
'*  Purpose: to put together the mail message
'*  Modification History
'*-------------------------------------------------------------------
'*  Date        Who     Description
'*  20080502        LEarnest       Creation
'********************************************************************

Dim asBodyLines() As String
Dim sBodyLine As Variant
Dim asFiles() As String
Dim sFile As String
Dim oFSO As Object
Dim bSendFile As Boolean
Dim nFileCounter As Integer
Dim oMI As Outlook.MailItem

Set oFSO = CreateObject("Scripting.FileSystemObject")

sBody = sBody & vbCrLf  'put a CR/LF in the body to split
    
asBodyLines = Split(sBody, Chr(13) & Chr(10))

nFileCounter = 0
For Each sBodyLine In asBodyLines
    If sBodyLine <> "" Then
        nFileCounter = nFileCounter + 1
        If nFileCounter = 1 Then
            Set oMI = CreateNewEmail()
            If oMI Is Nothing Then LogNote oNote, "Unable to create new mail message. "
            oMI.To = sRecipient
            oMI.subject = "Requested Files"
        End If
        
        'start a new
        bSendFile = False
        
        sBodyLine = Trim(sBodyLine)
        'determine if this is a file request
        If LCase(Left(sBody, Len(filePrefix))) = LCase(filePrefix) Then
            'process this request
            sBodyLine = Trim(Mid(sBodyLine, Len(filePrefix) + 1)) 'extract the file name
            
            'determine if this is a real file
            If oFSO.fileexists(sBodyLine) Then bSendFile = True
            
            If Not bSendFile Then
                'check to see if it exists with default path
                sBodyLine = Replace(defaultLocation + sBodyLine, "\\", "\")
                bSendFile = oFSO.fileexists(sBodyLine)
            End If
        End If
        
        'send file
        If bSendFile Then
            oMI.Attachments.Add sBodyLine
            oMI.Body = oMI.Body & "Attached file " & sBodyLine & vbCrLf
            LogNote oNote, "Attached " & sBodyLine
        End If
        
        If nFileCounter = 5 Then
            oMI.Send
            nFileCounter = 0
            If Not oMI Is Nothing Then Set oMI = Nothing
            LogNote oNote, "Sent Mail"
        End If
    End If
Next sBodyLine

If Not oMI Is Nothing Then
    If oMI.Body <> "" Then oMI.Send
    Set oMI = Nothing
End If

End Sub
Private Function CreateNewEmail() As Outlook.MailItem
'********************************************************************
'*  Created on 5/2/08
'*  Created by LEarnest
'*
'*  Modification History
'*-------------------------------------------------------------------
'*  Date        Who     Description
'*  20080502        LEarnest       Creation
'********************************************************************

Dim oNameSpace As Outlook.nameSpace
Dim oMapiFolder As Outlook.mapiFolder
Dim oMailItem As Outlook.MailItem

Set oNameSpace = Application.Session
If Not oNameSpace Is Nothing Then
    oNameSpace.Logon , , True, False
    
    Set oMapiFolder = oNameSpace.GetDefaultFolder(olFolderOutbox)
    If Not oMapiFolder Is Nothing Then
        Set oMailItem = oMapiFolder.Items.Add(olMailItem)
    End If
End If
Set CreateNewEmail = oMailItem

End Function
Private Sub LogNote(oNote As NoteItem, sMessage As String)
'********************************************************************
'*  Created on 5/2/08
'*  Created by LEarnest
'*
'*  Modification History
'*-------------------------------------------------------------------
'*  Date        Who     Description
'*  20080502        LEarnest       Creation
'********************************************************************
    If logAttempts Then
        
        If Trim(sMessage) <> "" Then
            oNote.Body = oNote.Body & sMessage + ": " + Format(Now(), "MM/dd/YYYY hh:mm") & vbCrLf
        Else
            oNote.Body = oNote.Body & vbCrLf
        End If
    End If
End Sub