كيف تتحقق من عناوين المستلمين قبل الإرسال عبر Outlook؟

في بعض الأحيان ، قد تفوتك إضافة بعض المستلمين المهمين إلى حقول "إلى" أو "نسخة إلى" أو "نسخة مخفية الوجهة" أثناء إرسال رسائل بريد إلكتروني عبر Outlook. هنا ، يمكنني تقديم طريقة للتحقق مما إذا كانت عناوين البريد الإلكتروني المحددة قد تمت إضافتها قبل إرسالها عبر Outlook.

تحقق من العناوين قبل الإرسال برمز VBA

تحقق من العناوين قبل الإرسال برمز VBA

هنا لدي رمزان يمكنهما مساعدتك في حل هذه الوظيفة ، يمكنك اختيار أي شخص تريده.

1. صحافة Alt + F11 كEys لتمكين ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

2. نقرتين متتاليتين هذه الجلسة تبدأ من Project1 لفتح محرر الكود ، انسخ والصق الكود أدناه للمحرر.

فبا: تحقق من عنوان المستلم في الحقل "إلى" قبل الإرسال

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'UpdatebyExtendoffice20180523
Dim xAddressArr() As Variant
Dim xAddress As String
Dim xRecipient As Recipient
Dim xPrompt As String
Dim xYesNo As Integer
Dim xDictionary As Scripting.Dictionary
On Error Resume Next
Set xDictionary = New Scripting.Dictionary
xAddressArr = Array("", "", "")
For i = LBound(xAddressArr) To UBound(xAddressArr)
    xDictionary.Add xAddressArr(i), True
Next i
For Each xRecipient In Item.Recipients
    If xRecipient.Type = olTo Then
        If xDictionary.Exists(xRecipient.Address) Then xDictionary.Remove xRecipient.Address
    End If
Next
If xDictionary.Count = 0 Then GoTo L1
For i = 0 To xDictionary.Count - 1
    If xAddress = "" Then
        xAddress = xDictionary.Keys(i)
    Else
        xAddress = xAddress + "; " & xDictionary.Keys(i)
    End If
Next i
xPrompt = "You are not sending this to: " & xAddress & ". Are you sure you want to send the Mail?"
xYesNo = MsgBox(xPrompt, vbQuestion + vbYesNo, "Kutools for Outlook")
If xYesNo = vbNo Then Cancel = True
L1:
  Set xRecipient = Nothing
  Set xDictionary = Nothing
End Sub

doc تحقق من عنوان المستلم قبل الإرسال 1

في الكود ، يمكنك التغيير ("""""") إلى المستلمين الحقيقيين الذين تحتاجهم.

3. ثم أيضا في ميكروسوفت فيسوال باسيك للتطبيقات الإطار، انقر فوق الأدوات > مراجع حسابات. الاختيار وقت تشغيل البرمجة لـ Microsoft خانة الاختيار في المراجع - مشروع 1 الحوار.

4. انقر OK وحفظ الكود.

الآن إذا لم يظهر المستلمون المحددون في الحقل "إلى" أثناء إرسال رسائل البريد الإلكتروني ، فسيظهر مربع حوار لتذكيرك إذا كنت تريد إرسال البريد الإلكتروني.
doc تحقق من عنوان المستلم قبل الإرسال 4

باستخدام الكود أعلاه ، فإنه يتحقق فقط من عناوين البريد الإلكتروني الموجودة إلى الحقل ، إذا كنت تريد تسجيل الوصول إلى, CC و BCC الحقول ، يمكنك استخدام الرمز أدناه.

VBA: تحقق من عنوان المستلم في حقول To / CC / BCC قبل الإرسال

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'UpdatebyExtendoffice20180523
Dim xRecipients As Outlook.Recipients
Dim xRecipient As Outlook.Recipient
Dim xPos As Integer
Dim xYesNo As Integer
Dim xPrompt As String
Dim xAddress As String
On Error Resume Next
If Item.Class <> olMail Then Exit Sub
Set xRecipients = Item.Recipients
xAddress = ""
For Each xRecipient In xRecipients
    xPos = InStr(LCase(xRecipient.Address), xAddress)
    If xPos = 0 Then
        xPrompt = "You sending this to " & xAddress & ". Are you sure you want to send it?"
        xYesNo = MsgBox(xPrompt, vbYesNo + vbQuestion + 4096, "Kutools for Outlook")
        If xYesNo = vbNo Then Cancel = True
    End If
Next xRecipient
End Sub

مع هذا الرمز ، لا تحتاج إلى التحقق وقت تشغيل البرمجة لـ Microsoft مربع الاختيار ، فقط احفظ الكود مباشرة ليصبح ساري المفعول.