循环遍历 Excel 宏中的不同过滤器选项

Question

我只是想知道如何遍历 excel 宏中的不同选项并执行相同的操作。

我的操作是将 ID 从 excel 导出到 Outlook 分发列表。

我使用了以下代码：

Public Sub DistributionList()
Dim objOutlook As New Outlook.Application
Dim objNameSpace As Outlook.Namespace
Dim objDistList As Outlook.DistListItem
Dim objMail As Outlook.MailItem
Dim objRecipients As Outlook.Recipients


Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objDistList = objOutlook.CreateItem(olDistributionListItem)
Set objMail = objOutlook.CreateItem(olMailItem)
Set objRecipients = objMail.Recipients
ActiveSheet.Range("$A$1:$C$10").AutoFilter Field:=3, Criteria1:= _
        "Team 1"
objDistList.DLName = "Team 1"

For i = 2 To Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
objRecipients.Add (Range("B" & i).Value)
Next i

objDistList.AddMembers objRecipients
objDistList.Display
objRecipients.ResolveAll

Set objOutlook = Nothing
Set objNameSpace = Nothing
Set objDistList = Nothing
Set objMail = Nothing
Set objRecipients = Nothing

End Sub

在上面的代码中这两行过滤一个团队并导出到一个分发列表，

ActiveSheet.Range("$A$1:$C$10").AutoFilter Field:=3, Criteria1:= _
        "Team 1"
objDistList.DLName = "Team 1"

我有三个团队，我想要三个分发列表。谁能帮我编辑这段代码，以便循环遍历文件并创建三个分发列表？

我是 VBA 新手，如有任何帮助，我们将不胜感激。

谢谢

Answer 1

Public Sub DistributionList()
Dim objOutlook As New Outlook.Application
Dim objNameSpace As Outlook.Namespace
Dim objDistList As Outlook.DistListItem
Dim objMail As Outlook.MailItem
Dim objRecipients As Outlook.Recipients
Dim i As Long, j as Long, teamNames() As String

'''The Team Names are Stored in array '''''''''
redim teamNames(1 to 3)
teamNames() = Split("Red,Green,Blue", ",")
'''''''''''''''''''''''''''''''''''''''''''''''
Set objNameSpace = objOutlook.GetNamespace("MAPI")

For j = LBound(teamNames) To UBound(teamNames) 
    Set objDistList = objOutlook.CreateItem(olDistributionListItem)
    Set objMail = objOutlook.CreateItem(olMailItem)
    Set objRecipients = objMail.Recipients

    ActiveSheet.Range("$A$1:$C$10").AutoFilter Field:=3, Criteria1:= _
    teamNames(j)
    objDistList.DLName = teamNames(j)

    For i = 2 To Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
        objRecipients.Add (Range("B" & i).Value)
    Next i

    objDistList.AddMembers objRecipients
    objDistList.Display
    objRecipients.ResolveAll
    Set objDistList = Nothing
    Set objMail = Nothing
    Set objRecipients = Nothing
next j

Set objOutlook = Nothing
Set objNameSpace = Nothing


End Sub

您可以尝试以上我认为它应该工作但没有尝试过。您应该有一种方法可以从电子表格的范围中或通过用户输入选择分发列表名称，而不仅仅是从 1-3 恕我直言。不过这取决于你。

谢谢