'Option Explicit
Public myItem As Outlook.MailItem

'Private Sub Application_Startup()
'
'    'IGNORE - This forces the VBA project to open and be accessible using automation
'    '         at any point after startup
'
'End Sub

Sub GetAttachments()
'************************************************************
'************************************************************
'Reads email from text message
'************************************************************
'************************************************************
    
    On Error GoTo exit_this
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim FileName As String
    Dim i As Integer
    Dim myItem As Outlook.MailItem
    
    
    Dim message_body As String
    Dim email_address As String
    Dim attach As String
    Dim attach_filename(4) As String
    
    
    
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
' Check Inbox for messages and exit of none found
    If Inbox.Items.Count = 0 Then
'        MsgBox "There are no messages in the Inbox.", vbInformation, "Nothing Found"
        Exit Sub
    End If
' Reads the subject of the message
    For i = 1 To Inbox.Items.Count
        attach_counter = 0
        Set myItem = Application.Session.GetDefaultFolder(olFolderInbox).Items(i)
        message_body = Trim(myItem.Body)
        
'Truncates the email message
        If Left(message_body, 1) = """" Then
            email_address = Right(message_body, Len(message_body) - 1)
            email_address = Left(email_address, InStr(email_address, """") - 1)
            If (Len(message_body) - 2) <> Len(email_address) Then
                attach = Trim(Right(message_body, Len(message_body) - InStrRev(message_body, """")) & ",")
                attach_counter = 0
                For j = 1 To Len(attach)
                    If Right(Left(attach, j), 1) = "," Then
                        attach_counter = attach_counter + 1
                    End If
                Next

                
                For k = 0 To attach_counter - 1

                    If Trim(Left(attach, InStr(attach, ",") - 1)) = "resume" Then
                        ending = ".doc"
                    ElseIf Trim(Left(attach, InStr(attach, ",") - 1)) = "vcard" Then
                        ending = ".vcf"
                    End If

                    attach_filename(k) = "D:\Academics\Text Attachments\" & Trim(Left(attach, InStr(attach, ",") - 1)) & ending
                    attach = Right(attach, InStr(attach, ","))


                Next
                              
            End If
            
        End If

'************************************************************
'************************************************************
'Sends email
'************************************************************
'************************************************************
        Dim MAPISession As Outlook.NameSpace
        Dim MAPIFolder As Outlook.MAPIFolder
        Dim MAPIMailItem As Outlook.MailItem
        Dim oRecipient As Outlook.Recipient
    
        Dim TempArray() As String
        Dim varArrayItem As Variant
        Dim strEmailAddress As String
        Dim strAttachmentPath As String
    
        'Get the MAPI NameSpace object
        Set MAPISession = Application.Session
    
        If Not MAPISession Is Nothing Then
    
          'Logon to the MAPI session
          MAPISession.Logon , , True, False
    
          'Create a pointer to the Outbox folder
          Set MAPIFolder = MAPISession.GetDefaultFolder(olFolderOutbox)
          If Not MAPIFolder Is Nothing Then
    
            'Create a new mail item in the "Outbox" folder
            Set MAPIMailItem = MAPIFolder.Items.Add(olMailItem)
            If Not MAPIMailItem Is Nothing Then
    
              With MAPIMailItem
    
                'Create the recipients TO
                    strEmailAddress = email_address
                    If Len(strEmailAddress) > 0 Then
                        Set oRecipient = .Recipients.Add(strEmailAddress)
                        oRecipient.Type = olTo
                        Set oRecipient = Nothing
                    End If
    
                'Set the message SUBJECT
                    .Subject = "Files from Michael Humphreys"
                'Set the message BODY (HTML or plain text)
    '                .Body
    
                'Add any specified attachments
    
                    For Each varArrayItem In attach_filename
                        strAttachmentPath = Trim(varArrayItem)
                        If Len(strAttachmentPath) > 0 Then
                            .Attachments.Add strAttachmentPath
                        End If
                    Next varArrayItem
                .Send 'No return value since the message will remain in the outbox if it fails to send
                Set MAPIMailItem = Nothing
              End With
            End If
            Set MAPIFolder = Nothing
          End If
          MAPISession.Logoff
        End If
        'If we got to here, then we shall assume everything went ok.
    
    myItem.Move Outlook.Session.Folders(Outlook.Session.GetDefaultFolder(olFolderInbox).Parent.Name).Folders("Texts")
        
        
    Next
' Clear memory
GetAttachments_exit:
    Set ns = Nothing
    Set myItem = Nothing
    Exit Sub
    
' Handle errors
exit_this:
'    MsgBox "An unexpected error has occurred." _
'        & vbCrLf & "Please note and report the following information." _
'        & vbCrLf & "Macro Name: GetAttachments" _
'        & vbCrLf & "Error Number: " & Err.Number _
'        & vbCrLf & "Error Description: " & Err.Description _
'        , vbCritical, "Error!"
    Exit Sub 'Resume GetAttachments_exit
End Sub

Sub Initialize_handler()
    Set myItem = Application.Session.GetDefaultFolder(olFolderInbox).Items(1)
    myItem.Display
End Sub

Private Sub myItem_Open(Cancel As Boolean)
    Dim mymsg As String
    If myItem.UnRead = True Then
        Cancel = False
    Else
        Cancel = True
    End If
'        mymsg = "You have already read this message. Do you want to open this message again?"
'        If MsgBox(mymsg, 4) = 6 Then
'            Cancel = False
'        Else
'            Cancel = True
'        End If
'    End If
End Sub