VBA Email unique people based on recordset-CodePudding

I've got the following code I'm using to loop through a recordset and pull names to email. The problem is I want to set this up so it only grabs a person once. If they already exist then I don't want to add them again.

I'm not sure the best way to handle it. I'm assuming maybe a count? but I'm not sure how that would work in this case. Any help or push in the right direction would be greatly apprecaited!

Set rs = db.OpenRecordset("InSMasterQuery")
   With objMail
       .To = "<[email protected]>"
       .CC = objOutlookApp.GetNamespace("MAPI").Session.CurrentUser.AddressEntry
            With rs
            If .EOF And .BOF Then
                Else
                Merch = ""
                Do Until .EOF
                    Merch = Merch & ";" & ![Merchandiser]
                    .MoveNext
                Loop
                objMail.CC = Merch & objOutlookApp.GetNamespace("MAPI").Session.CurrentUser.AddressEntry
                objMail.Display
                End If
            End With
       .Subject = "In Season Markdown Request " & strSeason & " From " & Request & ""
       .Body = "The following is a In Season Markdown Request from " & Request & " Using Version " & Mid(Cver, 24, 6) & ""
       .Attachments.Add myWorkbook.FullName
       .Attachments.Add CopyFile.FullName
       .Attachments.Add UploadFile.FullName
       .Send
  End With

CodePudding user response：

Using a Dictionary:

Dim dictMerch As Object, currUsr

'...
'...
Set rs = Db.OpenRecordset("InSMasterQuery")

currUsr = objOutlookApp.GetNamespace("MAPI").Session.CurrentUser.AddressEntry
With objMail
    .To = "<[email protected]>"
    .CC = currUsr
     With rs
         If Not .EOF And Not .BOF Then
             Set dictMerch = CreateObject("Scripting.Dictionary")
             Merch = ""
             Do Until .EOF
                 dictMerch(.Fields("Merchandiser").Value) = True 'add to dictionary FIXED
                 .MoveNext
             Loop
             objMail.CC = Join(dictMerch.Keys, ";") & ";" & currUsr
             objMail.Display
         End If
     End With
    .Subject = "In Season Markdown Request " & strSeason & " From " & Request & ""
    .Body = "The following is a In Season Markdown Request from " & Request & " Using Version " & Mid(Cver, 24, 6) & ""
    .attachments.Add myWorkbook.FullName
    .attachments.Add CopyFile.FullName
    .attachments.Add UploadFile.FullName
    .Send
End With