Question

要生成邮件列表，我已经认识到在我的变量“To”中包含相同的值test@test.com。邮件列表是在Visual Basic for Applications（VBA）中定义的。好吧，我正在考虑如何定义要检查的语句，当变量具有相同的值然后修剪所有重复项。这意味着我需要变量在邮件列表中只出现一次。

例如：

Dim objMail As Object
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With objMail
  .To = test@test.com; name1@test.com; name2@test.com; name3@test.com; test@test.com; name4@test.com
  ...
End With

有没有人有想法？

Answer 1

您可以使用字典删除重复项：

Sub Test()

    Dim EmailAddresses As String

    EmailAddresses = "test@test.com; name1@test.com; name2@test.com; name3@test.com; test@test.com; name4@test.com"
    EmailAddresses = RemoveDuplicates(EmailAddresses)

    Debug.Print EmailAddresses

End Sub

Public Function RemoveDuplicates(sTo As String) As String

    Dim dict As Object
    Dim vEmails As Variant
    Dim x As Long
    Dim sTemp As String

    vEmails = Split(Replace(sTo, " ", ""), ";")
    If UBound(vEmails) > 0 Then
        'Remove duplicates.
        Set dict = CreateObject("Scripting.Dictionary")
        For x = LBound(vEmails) To UBound(vEmails)
            If Not dict.exists(vEmails(x)) Then
                dict.Add vEmails(x), 1
                sTemp = sTemp & vEmails(x) & ";"
            End If
        Next x
        sTemp = Left(sTemp, Len(sTemp) - 1) 'Remove the final ;
        RemoveDuplicates = sTemp
    Else
        'There's only 1 address.
        RemoveDuplicates = sTo
    End If

End Function

如果这是你的偏好，上面的实际上也可以通过几种方式简化。

对于这样的简单重复数据删除，不需要使用。Exists方法或.Add方法，因为字典项是懒惰创建的。这意味着，如果它不存在，那么简单地引用一个项就会创建它，如果不存在则会覆盖它。
您可以Join在词典的Keys上运行，而不是手动构建与字典并行的字符串。

以下是修订版：

Public Function RemoveDuplicates2(sTo As String) As String
    Dim dict As Object
    Dim vEmails As Variant
    Dim x As Long

    vEmails = Split(Replace(sTo, " ", ""), ";")
    Set dict = CreateObject("Scripting.Dictionary")
    For x = LBound(vEmails) To UBound(vEmails)
       dict(vEmails(x)) = dict(vEmails(x)) 'Keep track of how many occurrences, in case you want to do something with it later
    Next

    RemoveDuplicates = Join(dict.Keys(), "; ")

End Function

变量包含相同的值（VBA）

1 个答案: