在Excelmacros中通过不同的filter选项循环

我只是想知道如何循环通过Excelmacros中的不同选项，并执行相同的操作。

我的操作是从Excel导出ID到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" 

我有三个团队，我想要三个通讯组列表。 任何人都可以帮我编辑这段代码，这样它就可以遍历文件并创build三个分发列表了吗？

我是新来的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 

你可以尝试以上我认为它应该工作，但没有尝试出来。 您应该有一种方法来从电子表格的范围或用户input中select分配列表名称，而不是从1-3 IMHO中计数。 这取决于你。

谢谢