Сценарий Outlook: пересылка писем на основе таблицы данных Excel

Question

Я пытаюсь решить следующее.

У меня есть входящие, которые принимают письма от сотен тысяч отправителей.Каждый отправитель имеет назначенного представителя.

Я хочу сценарий outlook, который будет интеллектуально пересылать входящие электронные письма их правильному представителю учетной записи.

Первоначально я думал о том, чтобы написать сценарий Outlook, который ссылается на лист Excel, который будет содержать 2 столбца

(1 для адреса электронной почты отправителей и 1 для сообщения электронной почты для отправки), но послеМногие неудачные попытки заставить Outlook общаться с Excel, я решил попробовать, используя контакты Outlook.

Я придумал следующий сценарий.

Sub TestForward(Item As Outlook.MailItem)

  Dim Folder As Outlook.MAPIFolder
  Dim Items As Outlook.Items
  Dim obj As Object
  Dim Contact As Outlook.ContactItem
  Dim emailSender As String
  Dim TPOCustomer
  Dim HMC As String
  Dim olNs As Outlook.NameSpace
  Dim olApp As Outlook.Application

  Set olApp = New Outlook.Application
  Set olNs = olApp.GetNamespace("MAPI")



  emailSender = Item.SenderEmailAddress

  Set Folder = olNs.GetDefaultFolder(olFolderContacts).Folders("TPO HMC").Folders("test")
  If Folder Is Nothing Then Exit Sub
  If Folder.DefaultItemType = olContactItem Then
  Dim i As Integer
    Set Items = Folder.Items
    For Each obj In Items
      If TypeOf obj Is Outlook.ContactItem Then
        Set Contact = obj
        TPOCustomer = Contact.FirstName
        If TPOCustomer = emailSender Then
          HMC = Contact.Email1Address
          Set myForward = Item.Forward
          myForward.Recipients.Add HMC
          myForward.Send
        End If
      End If
    Next
  End If


End Sub

'********************************************************************

Работает, но работает невероятно медленно.Обработка 1 электронного письма занимает всего около 60-90 секунд с использованием только 10 тыс. Тестовых контактов.Я полагаю, что если я сделаю поиск по сотням тысяч, это испортит мою электронную почту.

Я открыт для любых предложений по решению исходной проблемы.Я все еще думаю, что ссылка на Excel - это путь.Извините за неаккуратный код, я новичок в VB, и я впервые пытаюсь использовать его для сценария Outlook

'Creating Public variables to handle Outlook Application
  Dim olNs As Outlook.NameSpace
  Dim olApp As Outlook.Application
  Dim Folder As Outlook.MAPIFolder
  Dim Items As Outlook.Items
  Dim obj As Object
  Dim emailSender As String
  Dim TPOCustomer
  Dim HMC As String


'Public Function to Create and search through Excel Document
Public Function openExcel()

'Create the Excel instance
     Dim xlApp As Object
     Dim sourceWB
     Dim sourceWS

     Set xlApp = CreateObject("Excel.Application")

     With xlApp
         .Visible = False
         .EnableEvents = True
     End With

'Set path of Excel workbook
     strFile = "\\azt2nsf701z1.wellsfargo.net\C_MTGCRS_Users\U495570\My Documents\testTPO3.xlsx"

'Set workbook and worksheet
     Set sourceWB = xlApp.Workbooks.Open(strFile, , False, , , , , , , True)
     Set sourceWS = sourceWB.Worksheets("testTPO")




sourceWS.Range("C1").Value = emailSender

sourceWS.Range("D1").Calculate
HMC = sourceWS.Range("D1").Value



     sourceWB.Activate





 End Function


Sub TestForward(Item As Outlook.MailItem)

 'Set Outlook Application
  Set olApp = New Outlook.Application
  Set olNs = olApp.GetNamespace("MAPI")

 'Set the email Sender
  emailSender = Item.SenderEmailAddress

Call openExcel

'Forward the email
Set myForward = Item.Forward
myForward.Recipients.Add HMC
myForward.Send
End Sub