Question

我正在尝试解决以下问题。

我有一个收件箱，可以接收来自成千上万个发件人的电子邮件。每个发件人都有一个分配的帐户代表。

我想要一个Outlook脚本，该脚本可以智能地将收到的电子邮件转发到其适当的帐户代表。

最初的想法是编写一个Outlook脚本，该脚本引用一个包含2列的Excel工作表

（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万个测试联系人才能处理1封电子邮件，大约需要60-90秒。我想如果我搜索成千上万的邮件，它将使我的电子邮件崩溃。

我愿意提出任何解决原始问题的建议。我仍然认为引用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

Outlook脚本：基于Excel数据表转发电子邮件

0 个答案: