将地址存储到数组中，然后在该数组中查找数据

我试图自动化设置项目使用Excel VBA的方式，但很新的编码。

到目前为止，我所拥有的function是从我的Outlook全局地址列表中获取人名和电子邮件，并将其存储到excel页面（“电子邮件地址”）。接下来，它根据项目中所需的职位types，它通过Excel中的“电子邮件地址”页面find公司内部的人员，并提供一个下拉列表供用户select。 最后，名称被选中后，它提供了每个团队成员的电子邮件地址。

以下是我到目前为止的代码。

Sub emailfromoutlook() Dim appOL As Object Dim oGAL As Object Dim oContact As Object Dim oUser As Object Dim arrUsers(1 To 65000, 1 To 3) As String Dim UserIndex As Long Dim i As Long Set appOL = CreateObject("Outlook.Application") Set oGAL = appOL.GetNamespace("MAPI").AddressLists("Global Address List").AddressEntries Worksheets("Email Address").Activate For i = 1 To oGAL.Count Set oContact = oGAL.Item(i) If oContact.AddressEntryUserType = 0 Then Set oUser = oContact.GetExchangeUser If Len(oUser.LastName) > 0 Then UserIndex = UserIndex + 1 arrUsers(UserIndex, 1) = oUser.JobTitle arrUsers(UserIndex, 2) = oUser.Name arrUsers(UserIndex, 3) = oUser.PrimarySmtpAddress End If End If Next i appOL.Quit If UserIndex > 0 Then Range("A2").Resize(UserIndex, UBound(arrUsers, 2)).Value = arrUsers End If Set appOL = Nothing Set oGAL = Nothing Set oContact = Nothing Set oUser = Nothing Erase arrUsers End Sub Sub dependent_list() Dim a As Integer Dim b As String Range("C2:C50").Select With Selection.Validation .Delete .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _ :=xlBetween .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With a = 2 Do Until Worksheets("Sheet1").Cells(a, 2) = 0 Dim find As String Dim array1(200) Dim i As Integer Dim j As Integer Dim k As String Worksheets("Email Address").Select Erase array1 find = Worksheets("Sheet1").Cells(a, 2).Value For i = 2 To 330 k = Worksheets("Email Address").Cells(i, 1) If k = find Then array1(j) = Worksheets("Email Address").Cells(i, 2) j = j + 1 Else 'do it another thing End If Next i Worksheets("Sheet1").Select Cells(a, 3).Select With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=Join(array1, ",") .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With a = a + 1 Loop End Sub Sub email() Dim c As Integer Dim d As String Dim e As String Dim f As Integer For c = 2 To 50 d = Worksheets("Sheet1").Cells(c, 3).Value For f = 2 To 330 e = Worksheets("Email Address").Cells(f, 2) If d = e Then Worksheets("Sheet1").Cells(c, 4) = Worksheets("Email Address").Cells(f, 3) Else End If Next f Next c End Sub 

这个工作正常，因为它允许我根据项目中可用的职位select团队中的成员，并为我提供他们的电子邮件地址，但它有一个缺陷。 Outlook中的全局地址列表将随着时间的推移而更新（作为人员，雇用和解雇），但不会直接更新Excel中的电子邮件地址页面。

为了解决这个问题，我写了一个临时的解决scheme，每次打开excel页面时都会刷新，以防发生变化，但这不是一个好的长期解决scheme。

  Private Sub Workbook_Open() Sheets("Email Address").UsedRange.ClearContents Call emailfromoutlook Worksheets("Email Address").Range("A1") = "Job Title" Worksheets("Email Address").Range("B1") = "Full Name" Worksheets("Email Address").Range("C1") = "Email Address" Worksheets("Email Address").Range("A1:C1").Font.Bold = True MsgBox "Email Address book has been updated" End Sub 

所以对于一个长期的修复，我想如果有可能将全局地址列表存储在一个临时数组中，然后执行所有这些function，而不是把它们放在Excel页面上。 但是，我没有丝毫的线索知道如何做到这一点。

任何帮助或不同的想法做同样的不胜感激。 请随时要求澄清，因为我意识到这是一个非常漫长而复杂的问题。

谢谢。