Переменная содержит те же значения (VBA)

Question

Чтобы создать список рассылки, я узнал, что в моей переменной «Кому» содержатся те же значения test@test.com. Список рассылки был определен в Visual Basic для приложений (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 

выше на самом деле может быть упрощен несколько способов, также, если это ваши предпочтения.

1. Для простого удаления дубликатов, не нужно использовать. Exists метод или метод .Add, потому что словарные статьи создаются лениво. Это означает, что простое обращение к элементу будет создавать его, если оно не существует, или перезаписать его, если это произойдет.
2. Вместо того, чтобы вручную строить строку параллельно со словарем, вы можете 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