Vba 在Excel宏中循环使用不同的过滤器选项

我只是想知道如何循环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新手，如有任何帮助，将不胜感激

谢谢

你可以试试上面的方法，我认为应该有效，但没有试过。您应该能够从电子表格中的范围或通过用户输入选择通讯组列表名称，而不仅仅是从1-3 IMHO开始计数。但这取决于你

谢谢

你可以试试上面的方法，我认为应该有效，但没有试过。您应该能够从电子表格中的范围或通过用户输入选择通讯组列表名称，而不仅仅是从1-3 IMHO开始计数。但这取决于你

---

谢谢

在此代码中，我们如何传递团队名称？为了测试的目的，我刚刚命名为团队1。理想情况下，每个团队名称都有不同的文本名称。我们可以修改代码以给出名称吗？确定要从指定的范围或其他地方获取团队名称的位置吗？我不想获取名称，我想在开始时对名称进行硬编码，以便我们可以从那里使用。然后是什么名称，以便我可以将它们放在那里？我们可以将其设置为红色、蓝色和绿色吗？在这段代码中，我们如何传递团队名称？为了测试的目的，我刚刚命名为团队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