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恕我直言中计算。这取决于你。

由于

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

1 个答案: