Outlook, meerdere mailadressen in BCC

[samabert]

Hallo,

Hoe kan de code aangepast worden om onder strBCC meerdere mailadressen te vermelden.
De code werkt wel met 1 mailadres in strBCC.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim objRecip As Recipient
    Dim strMsg As String
    Dim res As Integer
    Dim strBcc As String
    On Error Resume Next
    If Item.SenderEmailAddress = "test@info.be" Then
        strBcc = "mail@info.be"   '  + 12 andere mailadressen
        Set objRecip = Item.Recipients.Add(strBcc)
        objRecip.Type = olBCC
        If Not objRecip.Resolve Then
            strMsg = "Could not resolve the Bcc recipient. " & _
                     "Do you want still to send the message?"
            res = MsgBox(strMsg, vbYesNo, _
                     "Could Not Resolve Bcc Recipient")
            If res = vbNo Then
                Cancel = True
            End If
        End If
    End If
End Sub

Alvast bedankt.
Marc

 

[edmoor]

Zet de adressen gescheiden door een ; in de string.

 

[samabert]

edmoor,

Ik heb volgende getest en dit werkt niet. "abc@info.be; cba@info.be"
Ik krijg de message: "Could Not Resolve Bcc Recipient")
Met 1 mailadres werkt het wel.

 

[edmoor]

Je moet dan die adressen per stuk resolven.

 

[samabert]

Ofwel doe ik het verkeerd ofwel is er toch nog iets anders dat niet juist is. Het werkt niet, enkel met 1 mailadres is er geen probleem.
Volgende krijg ik uiteindelijk te zien.



De mailadressen die ik gebruik in BCC, zijn mailadressen die in Outlook adresboek staan.

 

[edmoor]

Doe het eens zo:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim arrRecip() As Recipient
    Dim strMsg As String
    Dim i As Integer
    Dim arrEmails()
    
    arrEmails = Array("abc@info.be", "cba@info.be", "a@.com") [COLOR="#008000"]'Hier kan je meer adressen toevoegen[/COLOR]
     
    ReDim arrRecip(UBound(arrEmails))
    For i = 0 To UBound(arrEmails)
        Set arrRecip(i) = Item.Recipients.Add(arrEmails(i))
        arrRecip(i).Type = olBCC
        
        If Not arrRecip(i).Resolve Then
            strMsg = "Could not resolve the Bcc recipient. " & arrRecip(i) & vbCrLf & "Do you want still to send the message?"
            If MsgBox(strMsg, vbYesNo + vbDefaultButton1, "Could Not Resolve Bcc Recipient") = vbNo Then
                Cancel = True
            End If
        End If
        
        Set arrRecip(i) = Nothing
    Next i
End Sub

 

[samabert]

Super! Dit doet zijn werk :thumb:

Bedankt voor jouw hulp.
Mvg.
Marc

 

[snb]

Kijk eens hier:

https://www.snb-vba.eu/VBA_Outlook_external.html#L_3.1.3.3

 

[samabert]

snb,
Bedankt voor de tip.
Prachtige website vol info!