VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ArmExchange"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'what is new
' 2.2.7 Support for SPA linked emails (JN)


#If LIVE = 1 Then
Private mo_Session As Object
Private mo_OutlookApp As Object
#Else
Private mo_Session As outlook.NameSpace
Private mo_OutlookApp As outlook.Application
#End If

Dim md_MailBoxFolderInfo As Dictionary

Public WithEvents me_OlItems As outlook.Items
Attribute me_OlItems.VB_VarHelpID = -1

Public Event MoveMailErr(ls_ErrNr As String, ls_ErrSource As String, ls_ErrDesc As String)

Public Event ArmExchangeError(ll_errNr As Long, ls_ErrSource As String, ls_ErrDesc As String, ls_fnc As String)

Private mb_SaveMessageOnSend As Boolean

Public Enum ArmExchError
    InformationalError = 0
    UnresolvedEXRecipient = 1
    AttachementNotAdded = 2         ' added 5.1.2012 JN
End Enum

Private Sub me_OlItems_ItemAdd(ByVal lo_item As Object)
#If LIVE = 1 Then
Dim lo_folder As Object
Dim lo_DefaultFolder As Object
Dim lo_UserFolder As Object
Dim lo_OutlookApp As Object
Dim lo_Session As Object
#Else
Dim lo_folder As outlook.MAPIFolder
Dim lo_DefaultFolder As outlook.MAPIFolder
Dim lo_UserFolder As outlook.MAPIFolder
Dim lo_OutlookApp As outlook.Application
Dim lo_Session As outlook.NameSpace
#End If
Dim ls_From As String
Dim ls_MailBoxName As String
Dim lb_Moved As Boolean
Dim lb_MailboxLocated As Boolean

On Error GoTo ErrorHandler
  
  Set lo_OutlookApp = CreateObject("Outlook.Application")
  Set lo_Session = lo_OutlookApp.GetNamespace("MAPI")
  
  lb_Moved = False
  lb_MailboxLocated = False

  If Not (lo_Session Is Nothing) Then
    If TypeName(lo_item) = "MailItem" Then
        If Len(lo_item.SentOnBehalfOfName) > 0 Then
            ls_From = GetSMTPEmailAddress(lo_item, lo_Session)
            ls_MailBoxName = md_MailBoxFolderInfo.Item(ls_From)
            If ls_MailBoxName <> "" Then
                For Each lo_folder In lo_Session.Folders
                    If lo_folder.Name = ls_MailBoxName Then
                        lb_MailboxLocated = True
                        For Each lo_UserFolder In lo_folder.Folders
                            If lo_UserFolder.Name = "Sent Items" Then
                                Set lo_DefaultFolder = lo_Session.GetDefaultFolder(olFolderInbox)
                                If lo_DefaultFolder.Parent <> lo_UserFolder.Parent Then
                                    Call lo_item.Move(lo_UserFolder)
                                End If
                                lb_Moved = True
                            End If
                        Next
                    End If
                Next
                If lb_MailboxLocated = False Then
                RaiseEvent MoveMailErr("0", "ArmExchange.me_OlItems_ItemAdd", "Cannot find mailbox:" & ls_MailBoxName & " for mail SentOnBehalfOf:" & lo_item.SentOnBehalfOfName & " address:" & lo_item.SenderEmailAddress)
                End If
                If lb_Moved = False And lb_MailboxLocated = True Then
                RaiseEvent MoveMailErr("0", "ArmExchange.me_OlItems_ItemAdd", "Cannot find Sent Items folder for:" & ls_MailBoxName)
                End If
            End If
        End If
    End If
  End If
  
  Set lo_DefaultFolder = Nothing
  Set lo_OutlookApp = Nothing
  Set lo_Session = Nothing
  Exit Sub
ErrorHandler:
  Set lo_DefaultFolder = Nothing
  Set lo_OutlookApp = Nothing
  Set lo_Session = Nothing
  RaiseEvent MoveMailErr(Err.Number, Err.Source, "From:" & ls_From & ",Mailbox:" & ls_MailBoxName & "; " & Err.Description)
End Sub

Public Sub Load_A_COM()
On Error GoTo ErrorHandler
    Set me_OlItems = outlook.Session.GetDefaultFolder(olFolderSentMail).Items
  Exit Sub
ErrorHandler:
  Set me_OlItems = Nothing
  RaiseEvent ArmExchangeError(Err.Number, Err.Source, Err.Description, "Load_A_COM")
End Sub

Public Sub Unload_A_COM()
  Set mo_OutlookApp = Nothing
  Set mo_Session = Nothing
  Set me_OlItems = Nothing
End Sub

Public Property Let MailBoxFolderInfo(ab_Value As Dictionary)
    Set md_MailBoxFolderInfo = ab_Value
End Property

Public Property Let SaveMessageOnSend(ab_Value As Boolean)
  mb_SaveMessageOnSend = ab_Value
End Property

Public Property Get SaveMessageOnSend() As Boolean
  SaveMessageOnSend = mb_SaveMessageOnSend
End Property

Public Function OpenDatabase(as_Location As String, as_MailFile As String, Optional as_Password As String) As Boolean
#If LIVE = 1 Then
Dim lo_folderIn As Object
Dim lo_folderOut As Object
Dim lo_folderProcessed As Object
#Else
Dim lo_folderIn As outlook.MAPIFolder
Dim lo_folderOut As outlook.MAPIFolder
Dim lo_folderProcessed As outlook.MAPIFolder
#End If
Dim lb_Result As Boolean


On Error GoTo ErrorHandler
  lb_Result = False
  
    Set mo_OutlookApp = CreateObject("Outlook.Application")
    
    If Not (mo_OutlookApp Is Nothing) Then
    
        If me_OlItems Is Nothing Then
            Set me_OlItems = outlook.Session.GetDefaultFolder(olFolderSentMail).Items
        End If

        Set mo_Session = mo_OutlookApp.GetNamespace("MAPI")
    
        If Not (mo_Session Is Nothing) Then
        
            Set lo_folderIn = GetMailboxFolder(as_Location, "Inbox")
            Set lo_folderOut = GetMailboxFolder(as_Location, "Outbox")
            Set lo_folderProcessed = GetMailboxFolder(as_Location, "Processed")
            
            If Not (lo_folderIn Is Nothing) And _
               Not (lo_folderOut Is Nothing) And _
               Not (lo_folderProcessed Is Nothing) Then
                OpenDatabase = True
            End If
        End If
    End If
    
    Set lo_folderIn = Nothing
    Set lo_folderOut = Nothing
    Set lo_folderProcessed = Nothing
    
  Exit Function
ErrorHandler:
    Set mo_OutlookApp = Nothing
    Set mo_Session = Nothing
    Set me_OlItems = Nothing
    OpenDatabase = False
    RaiseEvent ArmExchangeError(Err.Number, Err.Source, Err.Description, "OpenDatabase")
End Function

Public Function CloseDatabase() As Boolean

  Set mo_OutlookApp = Nothing
  Set mo_Session = Nothing
End Function


Public Function GetMailCount(as_Location As String) As Long
#If LIVE = 1 Then
Dim lo_folder As Object
#Else
Dim lo_folder As outlook.MAPIFolder
#End If

On Error GoTo ErrorHandler
  GetMailCount = -1
  
  If Not (mo_Session Is Nothing) Then
    Set lo_folder = GetMailboxFolder(as_Location, "Inbox")
    If Not (lo_folder Is Nothing) Then
        GetMailCount = lo_folder.Items.Count
    End If
  End If
  
  Set lo_folder = Nothing
  Exit Function
ErrorHandler:
  GetMailCount = -1
  RaiseEvent ArmExchangeError(Err.Number, Err.Source, Err.Description, "GetMailCount")
End Function

#If LIVE = 1 Then
Public Function IsItDefaultFolder(ao_Folder As Object) As Boolean
Dim lo_folder As Object
#Else
Public Function IsItDefaultFolder(ao_Folder As outlook.MAPIFolder) As Boolean
Dim lo_folder As outlook.MAPIFolder
#End If

On Error GoTo ErrorHandler
  IsItDefaultFolder = False
  
  If Not (mo_Session Is Nothing) Then
    Set lo_folder = mo_Session.GetDefaultFolder(olFolderInbox)
    If lo_folder.Parent = ao_Folder.Parent Then
        IsItDefaultFolder = True
    End If
  End If
  
  Set lo_folder = Nothing
  Exit Function
ErrorHandler:
  IsItDefaultFolder = False
  RaiseEvent ArmExchangeError(Err.Number, Err.Source, Err.Description, "IsItDefaultFolder")
End Function

#If LIVE = 1 Then
Public Function GetMailboxFolder(as_Location As String, as_FolderName As String) As Object
Dim lo_folder As Object
Dim lo_UserFolder As Object
#Else
Public Function GetMailboxFolder(as_Location As String, as_FolderName As String) As outlook.MAPIFolder
Dim lo_folder As outlook.MAPIFolder
Dim lo_UserFolder As outlook.MAPIFolder
#End If

On Error GoTo ErrorHandler
  Set GetMailboxFolder = Nothing
  
  If Not (mo_Session Is Nothing) Then
    For Each lo_folder In mo_Session.Folders
        If lo_folder.Name = as_Location Then
            For Each lo_UserFolder In lo_folder.Folders
                If lo_UserFolder.Name = as_FolderName Then
                    Set GetMailboxFolder = lo_UserFolder
                    Exit Function
                End If
            Next
        End If
    Next
  End If
  
  Set lo_folder = Nothing
  Exit Function
ErrorHandler:
  Set GetMailboxFolder = Nothing
  RaiseEvent ArmExchangeError(Err.Number, Err.Source, Err.Description, "GetMailboxFolder")
End Function

#If LIVE = 1 Then
Public Function MoveMail(ao_MailItem As Object, as_DstLocation As String, as_DstFolder As String) As Boolean
Dim lo_DestFolder As Object
#Else
Public Function MoveMail(ao_MailItem As outlook.MailItem, as_DstLocation As String, as_DstFolder As String) As Boolean
Dim lo_DestFolder As outlook.MAPIFolder
#End If

On Error GoTo ErrorHandler
  MoveMail = False
  If Not (mo_Session Is Nothing) Then
  
    Set lo_DestFolder = GetMailboxFolder(as_DstLocation, as_DstFolder)
    
    If Not (lo_DestFolder Is Nothing) And Not (ao_MailItem Is Nothing) Then
         Call ao_MailItem.Move(lo_DestFolder)
         MoveMail = True
    End If
    
    Set lo_DestFolder = Nothing
    
  End If
  Exit Function
ErrorHandler:
  Set lo_DestFolder = Nothing
  MoveMail = False
  RaiseEvent ArmExchangeError(Err.Number, Err.Source, Err.Description, "MoveMail")
End Function

#If LIVE = 1 Then
Public Function GetSMTPEmailAddress(ao_MailItem As Object, Optional ao_Session As Object) As String
Dim lo_Recip As Object
Dim lo_ExUser As Object
#Else
Public Function GetSMTPEmailAddress(ao_MailItem As outlook.MailItem, Optional ao_Session As outlook.NameSpace) As String
Dim lo_Recip As outlook.Recipient
Dim lo_ExUser As outlook.ExchangeUser
#End If

On Error GoTo ErrorHandler
  GetSMTPEmailAddress = ""
  
    'translate exchange address if needed
    If UCase(ao_MailItem.SenderEmailType) = "EX" Then
        If Not ao_Session Is Nothing Then
            Set lo_Recip = ao_Session.CreateRecipient(ao_MailItem.SenderEmailAddress)
        ElseIf Not mo_Session Is Nothing Then
            Set lo_Recip = mo_Session.CreateRecipient(ao_MailItem.SenderEmailAddress)
        Else
            Set lo_Recip = Nothing
        End If
        
        If Not lo_Recip Is Nothing Then
            If lo_Recip.Resolved Then
                Set lo_ExUser = lo_Recip.AddressEntry.GetExchangeUser()
                GetSMTPEmailAddress = lo_ExUser.PrimarySmtpAddress
            Else
                ' unresolved recipient
                GetSMTPEmailAddress = ao_MailItem.SenderName
                RaiseEvent ArmExchangeError(ArmExchError.InformationalError, "CreateRecepient", "Unresolved Sender (" & ao_MailItem.SenderName & " " & ao_MailItem.SenderEmailAddress & ")", "GetSMTPEmailAddress")
            End If
        End If
    Else
      GetSMTPEmailAddress = ao_MailItem.SenderEmailAddress
    End If
  
  Set lo_Recip = Nothing
  Set lo_ExUser = Nothing
  Exit Function
ErrorHandler:
  GetSMTPEmailAddress = ""
  RaiseEvent ArmExchangeError(Err.Number, Err.Source, Err.Description, "GetSMTPEmailAddress")
End Function

Public Function GetSMTPEmailAddressFromName(ByVal as_Name As String) As String
#If LIVE = 1 Then
Dim lo_Recip As Object
Dim lo_ExUser As Object
#Else
Dim lo_Recip As outlook.Recipient
Dim lo_ExUser As outlook.ExchangeUser
#End If

On Error GoTo ErrorHandler
  GetSMTPEmailAddressFromName = ""
  
    'translate exchange address if needed
    If Not mo_Session Is Nothing Then
        Set lo_Recip = mo_Session.CreateRecipient(as_Name)
    End If
        
    If Not lo_Recip Is Nothing Then
        Set lo_ExUser = lo_Recip.AddressEntry.GetExchangeUser()
        If Not lo_ExUser Is Nothing Then
            If lo_Recip.Resolved Then
                Set lo_ExUser = lo_Recip.AddressEntry.GetExchangeUser()
                GetSMTPEmailAddressFromName = lo_ExUser.PrimarySmtpAddress
            Else
                ' unresolved recipient
                GetSMTPEmailAddressFromName = as_Name
                RaiseEvent ArmExchangeError(ArmExchError.UnresolvedEXRecipient, "CreateRecepient", "Unresolved Sender (" & as_Name & ")", "GetSMTPEmailAddressFromName")
            End If

        End If
    End If
  
  Set lo_Recip = Nothing
  Set lo_ExUser = Nothing
  Exit Function
ErrorHandler:
  GetSMTPEmailAddressFromName = ""
End Function

#If LIVE = 1 Then
Public Function ReadMail(ao_Folder As Object, al_MailIndex As Long) As ArmMail
Dim lo_MailItem As Object
Dim lo_Recip As Object
Dim lo_ExUser As Object
#Else
Public Function ReadMail(ao_Folder As outlook.MAPIFolder, al_MailIndex As Long) As ArmMail
Dim lo_MailItem As outlook.MailItem
Dim lo_Recip As outlook.Recipient
Dim lo_ExUser As outlook.ExchangeUser
#End If

Dim lo_Mail As ArmMail
Dim ls_Text As String
Dim lv_Item As Variant, lv_Value As Variant, lv_Addr As Variant
Dim lo_item As Object
Dim ll_Index As Long

On Error GoTo ErrorHandler

  Set ReadMail = Nothing
  If Not (mo_Session Is Nothing) Then
    If Not (ao_Folder Is Nothing) Then
               
        If TypeName(ao_Folder.Items(al_MailIndex)) <> "MailItem" Then
            ao_Folder.Items(al_MailIndex).Delete
              Set lo_Mail = New ArmMail
              Call lo_Mail.Load_A_COM
              lo_Mail.IsReportItem = True
              Set ReadMail = lo_Mail
        Else
            Set lo_MailItem = ao_Folder.Items.Item(al_MailIndex)
            If Not (lo_MailItem Is Nothing) Then
              Set lo_Mail = New ArmMail
              Call lo_Mail.Load_A_COM
              Set lo_Mail.MailItem = lo_MailItem
              
              lo_Mail.AddrFrom = GetSMTPEmailAddress(lo_MailItem)
              
              'Fill recipients list (To)
              lo_Mail.AddrTo = lo_MailItem.To
                 
              'Fill recipients list (CopyTo)
              lo_Mail.AddrCc = lo_MailItem.CC
                 
              'Fill recipients list (BlankCopyTo)
              lo_Mail.AddrBcc = lo_MailItem.BCC
                 
              lo_Mail.Subject = lo_MailItem.Subject
              
              'read body and search for attachments
              lo_Mail.Body = lo_MailItem.Body
              
              If lo_MailItem.BodyFormat = outlook.olFormatHTML Then
                  lo_Mail.HTMLBody = lo_MailItem.HTMLBody
              End If
              
              For ll_Index = 1 To lo_MailItem.Attachments.Count
                Select Case lo_MailItem.Attachments.Item(ll_Index).Type
                    Case olByReference
                        If Not lo_Mail.AddAttachment(lo_MailItem.Attachments.Item(ll_Index).FileName) Then
                          RaiseEvent ArmExchangeError(ArmExchError.AttachementNotAdded, "AddAttachment(olByReference)", "Attachement not added (" & lo_MailItem.Attachments.Item(ll_Index).FileName & ")", "ReadMail")
                        End If
                    Case olByValue
                        If Not lo_Mail.AddAttachment(lo_MailItem.Attachments.Item(ll_Index).FileName) Then
                          RaiseEvent ArmExchangeError(ArmExchError.AttachementNotAdded, "AddAttachment(olByValue)", "Attachement not added (" & lo_MailItem.Attachments.Item(ll_Index).FileName & ")", "ReadMail")
                        End If
                    Case olEmbeddeditem
                        RaiseEvent ArmExchangeError(ArmExchError.AttachementNotAdded, "AddAttachment(olEmbeddeditem)", "Attachement skipped #" & ll_Index, "ReadMail")
                    Case olOLE
                        RaiseEvent ArmExchangeError(ArmExchError.AttachementNotAdded, "AddAttachment(olOLE)", "Attachement skipped #" & ll_Index, "ReadMail")
                End Select
              
              Next
              Set ReadMail = lo_Mail
            End If
        End If
    End If
  End If
  Exit Function
ErrorHandler:
  Set ReadMail = Nothing
  RaiseEvent ArmExchangeError(Err.Number, Err.Source, Err.Description, "ReadMail")
End Function

Public Function SendMail(ao_Mail As ArmMail, Optional as_saveAsPath As String = "") As Boolean
#If LIVE = 1 Then
Dim lo_MailItem As Object
Dim lo_folder As Object
Dim lo_Recipient As Object
#Else
Dim lo_MailItem As outlook.MailItem
Dim lo_folder As outlook.MAPIFolder
Dim lo_Recipient As outlook.Recipient
#End If

Dim lo_EmbObj As Object
Dim ll_Index As Long
Dim ls_ID As String
Dim lv_ArrayItem As Variant
Dim ls_EmailAddress As String
Dim lb_IsThisDefaultFolder As Boolean

On Error GoTo ErrorHandler

  If (Not (ao_Mail Is Nothing)) And (Not (mo_Session Is Nothing)) Then

    Set lo_folder = GetMailboxFolder(ao_Mail.SendFromLocation, "Outbox")
    
    If Not lo_folder Is Nothing Then

      'Create a new mail item in the "Outbox" folder
      Set lo_MailItem = lo_folder.Items.Add(olMailItem)
      If Not lo_MailItem Is Nothing Then
        
        'Create the recipients TO
        If IsArray(ao_Mail.AddrTo) Then
            For Each lv_ArrayItem In ao_Mail.AddrTo
            
                ls_EmailAddress = Trim(lv_ArrayItem)
                If Len(ls_EmailAddress) > 0 Then
                    Set lo_Recipient = lo_MailItem.Recipients.Add(ls_EmailAddress)
                    lo_Recipient.Type = olTo
                    Set lo_Recipient = Nothing
                End If
            
            Next lv_ArrayItem
        End If
        
        If IsArray(ao_Mail.AddrCc) Then
            For Each lv_ArrayItem In ao_Mail.AddrCc
            
                ls_EmailAddress = Trim(lv_ArrayItem)
                If Len(ls_EmailAddress) > 0 Then
                    Set lo_Recipient = lo_MailItem.Recipients.Add(ls_EmailAddress)
                    lo_Recipient.Type = olCC
                    Set lo_Recipient = Nothing
                End If
            
            Next lv_ArrayItem
        End If
        
        If IsArray(ao_Mail.AddrBcc) Then
            For Each lv_ArrayItem In ao_Mail.AddrBcc
            
                ls_EmailAddress = Trim(lv_ArrayItem)
                If Len(ls_EmailAddress) > 0 Then
                    Set lo_Recipient = lo_MailItem.Recipients.Add(ls_EmailAddress)
                    lo_Recipient.Type = olBCC
                    Set lo_Recipient = Nothing
                End If
            
            Next lv_ArrayItem
        End If
        
        lo_MailItem.Subject = ao_Mail.Subject
          
        'Set the message BODY (HTML or plain text)
        If ao_Mail.HTMLBody <> "" Then
            lo_MailItem.HTMLBody = ao_Mail.HTMLBody
        Else
            lo_MailItem.Body = ao_Mail.Body
        End If
        
    
        For ll_Index = 1 To ao_Mail.Attachments.Count
            lo_MailItem.Attachments.Add (ao_Mail.Attachments.Item(ll_Index))
        Next
        
        If mb_SaveMessageOnSend = False Then
            Set lo_MailItem.SaveSentMessageFolder = mo_Session.GetDefaultFolder(olFolderDeletedItems)
        End If
        
        lb_IsThisDefaultFolder = IsItDefaultFolder(lo_folder)
        If lb_IsThisDefaultFolder = False Then
            lo_MailItem.SentOnBehalfOfName = ao_Mail.SendAsAccount
        End If
        
        If as_saveAsPath <> "" Then
            Call lo_MailItem.SaveAs(as_saveAsPath, 3)      'olMSG
        End If
        
        lo_MailItem.send
        
                
        SendMail = True
      
      End If
    End If
  End If
  
  Exit Function
ErrorHandler:
  SendMail = False
  RaiseEvent ArmExchangeError(Err.Number, Err.Source, Err.Description, "SendMail")
End Function

