循环通过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 IMHO中进行计数。这取决于你。

谢谢