Note: The other languages of the website are Google-translated. Back to English

 كيف ترسل بريدًا إلكترونيًا إلى عدة مستلمين في قائمة من Excel عبر Outlook؟

إذا كان لديك عناوين بريد إلكتروني متعددة في عمود من ورقة العمل ، والآن ، فأنت تريد إرسال بريد إلكتروني إلى قائمة المستلمين هذه من Excel مباشرة دون فتح Outlook. في هذه المقالة ، سأتحدث عن كيفية إرسال بريد إلكتروني إلى عدة مستلمين من Excel في نفس الوقت.

أرسل بريدًا إلكترونيًا إلى عدة مستلمين من Excel باستخدام رمز VBA

أرسل بريدًا إلكترونيًا إلى عدة مستلمين باستخدام المصنف الحالي كمرفق باستخدام رمز VBA


السهم الأزرق الحق فقاعة أرسل بريدًا إلكترونيًا إلى عدة مستلمين من Excel باستخدام رمز VBA

يمكنك استخدام رمز VBA لإرسال رسالة إلى عدة مستلمين في وقت واحد ، يرجى القيام بما يلي:

1. اضغط باستمرار ALT + F11 مفاتيح لفتح ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

2. انقر إدراج > وحدة، والصق الكود التالي في ملف نافذة الوحدة.

كود فبا: أرسل بريدًا إلكترونيًا إلى عدة مستلمين

Sub sendmultiple()
'updateby Extendoffice
    Dim xOTApp As Object
    Dim xMItem As Object
    Dim xCell As Range
    Dim xRg As Range
    Dim xEmailAddr As String
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the addresses list:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xOTApp = CreateObject("Outlook.Application")
    For Each xCell In xRg
        If xCell.Value Like "*@*" Then
            If xEmailAddr = "" Then
                xEmailAddr = xCell.Value
            Else
                xEmailAddr = xEmailAddr & ";" & xCell.Value
            End If
        End If
    Next
    Set xMItem = xOTApp.CreateItem(0)
    With xMItem
        .To = xEmailAddr
        .Display
    End With
End Sub

3. ثم اضغط F5 مفتاح لتنفيذ هذا الرمز ، سيظهر مربع موجه لتذكيرك بتحديد قائمة العناوين ، انظر لقطة الشاشة:

إرسال مستند إلى عدة مستلمين 1

4. ثم اضغط OK، ونظرة الرسالة يتم عرض النافذة ، يمكنك رؤية إضافة جميع عناوين البريد الإلكتروني المحددة إلى ملف إلى ، وبعد ذلك يمكنك إدخال الموضوع وكتابة رسالتك ، انظر الصورة:

إرسال مستند إلى عدة مستلمين 2

5. بعد الانتهاء من الرسالة ، الرجاء الضغط إرسال زر ، وسيتم إرسال هذه الرسالة إلى هؤلاء المستلمين في قائمة ورقة العمل الخاصة بك.


السهم الأزرق الحق فقاعة أرسل بريدًا إلكترونيًا إلى عدة مستلمين باستخدام المصنف الحالي كمرفق باستخدام رمز VBA

إذا كنت بحاجة إلى إرسال رسالة إلى عدة مستلمين باستخدام المصنف الحالي كمرفق ، فيمكنك تطبيق رمز VBA التالي.

1. اضغط باستمرار على ALT + F11 مفاتيح لفتح ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

2. انقر إدراج > وحدة، والصق الكود التالي في ملف نافذة الوحدة.

رمز فبا: أرسل بريدًا إلكترونيًا إلى عدة مستلمين باستخدام المصنف الحالي كمرفق

Sub EmailAttachmentRecipients()
'updateby Extendoffice
    Dim xOutlook As Object
    Dim xMailItem As Object
    Dim xRg As Range
    Dim xCell As Range
    Dim xEmailAddr As String
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the arresses list:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xOutlook = CreateObject("Outlook.Application")
    Set xMailItem = xOutlook.CreateItem(0)
    For Each xCell In xRg
        If xCell.Value Like "*@*" Then
            If xEmailAddr = "" Then
                xEmailAddr = xCell.Value
            Else
                xEmailAddr = xEmailAddr & ";" & xCell.Value
            End If
        End If
    Next
    With xMailItem
        .To = xEmailAddr
        .CC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add ActiveWorkbook.FullName
        .Display
    End With
    Set xOutlook = Nothing
    Set xMailItem = Nothing
End Sub

3. بعد لصق الرمز ، اضغط على F5 مفتاح لتشغيل هذا الرمز ، ويظهر مربع موجه لتذكيرك بتحديد العناوين التي تريد إرسال رسالة إليها ، انظر لقطة الشاشة:

إرسال مستند إلى عدة مستلمين 3

4. ثم اضغط OK زر و Outlook الرسالة يتم عرض نافذة ، تمت إضافة جميع عناوين البريد الإلكتروني إلى إلى ، وتم إدراج المصنف الحالي كمرفق أيضًا ، وبعد ذلك يمكنك إدخال الموضوع وإنشاء رسالتك ، انظر لقطة الشاشة:

إرسال مستند إلى عدة مستلمين 4

5. ثم اضغط إرسال زر لإرسال هذه الرسالة إلى قائمة المستلمين مع المصنف الحالي كمرفق.


إرسال رسائل بريد إلكتروني مخصصة إلى عدة مستلمين بمرفقات مختلفة:

بإضافة إلى كوتولس ل إكسيل's إرسال رسائل البريد الإلكتروني ميزة ، يمكنك بسرعة إرسال رسائل بريد إلكتروني مخصصة إلى عدة مستلمين بمرفقات مختلفة من Excel عبر Outlook حسب حاجتك. في نفس الوقت ، يمكنك نسخة أو نسخة مخفية من الرسائل إلى شخص معين أيضًا. انقر لتنزيل Kutools for Excel!

doc إرسال رسائل بريد إلكتروني مخصصة 18 1


مقالة ذات صلة:

كيف ترسل رسائل بريد إلكتروني جماعية مخصصة إلى قائمة من Excel عبر Outlook؟


أفضل أدوات إنتاجية المكتب

Kutools for Excel يحل معظم مشاكلك ويزيد إنتاجيتك بنسبة 80٪

  • إعادة استخدام: أدخل بسرعة الصيغ المعقدة والرسوم البيانية وأي شيء استخدمته من قبل ؛ تشفير الخلايا مع كلمة السر إنشاء قائمة بريدية وإرسال رسائل البريد الإلكتروني ...
  • سوبر فورميولا بار (بسهولة تحرير أسطر متعددة من النص والصيغة) ؛ تخطيط القراءة (قراءة وتحرير أعداد كبيرة من الخلايا بسهولة) ؛ لصق في النطاق المصفى
  • دمج الخلايا / الصفوف / الأعمدة دون فقدان البيانات ؛ تقسيم محتوى الخلايا ؛ ادمج الصفوف / الأعمدة المكررة... منع تكرار الخلايا؛ قارن النطاقات
  • حدد مكرر أو فريد صفوف حدد صفوف فارغة (جميع الخلايا فارغة) ؛ البحث الفائق والبحث الغامض في العديد من المصنفات. تحديد عشوائي ...
  • نسخة طبق الأصل خلايا متعددة بدون تغيير مرجع الصيغة ؛ إنشاء المراجع تلقائيًا إلى أوراق متعددة أدخل الرموز النقطية، مربعات الاختيار والمزيد ...
  • استخراج النص، إضافة نص ، إزالة حسب الموضع ، إزالة الفضاء؛ إنشاء وطباعة المجاميع الفرعية لترحيل الصفحات ؛ التحويل بين محتوى الخلايا والتعليقات
  • سوبر تصفية (حفظ وتطبيق مخططات التصفية على أوراق أخرى) ؛ فرز متقدم حسب الشهر / الأسبوع / اليوم ، التكرار والمزيد ؛ مرشح خاص بواسطة bold، italic ...
  • اجمع بين المصنفات وأوراق العمل؛ دمج الجداول على أساس الأعمدة الرئيسية ؛ تقسيم البيانات إلى أوراق متعددة; تحويل دفعة xls و xlsx و PDF
  • أكثر من 300 ميزة قوية. يدعم Office / Excel 2007-2021 و 365. يدعم جميع اللغات. سهولة النشر في مؤسستك أو مؤسستك. الميزات الكاملة نسخة تجريبية مجانية لمدة 30 يومًا. ضمان استرداد الأموال لمدة 60 يومًا.
علامة تبويب kte 201905

يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
أوفيسيتاب القاع
فرز التعليقات حسب
التعليقات (20)
لا يوجد تقييم. كن أول من يقيم!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هذا رائع ، بالضبط ما أريده. هل هناك على أي حال لإضافة ميزة حيث يمكنك إضافة رسالة إلى سطر الموضوع باستخدام الرمز .... لا أريد أي شيء في مربع الرسائل
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، رمز VBA يعمل جيدًا بالنسبة لي ، شكرًا لك. هل هناك أي طريقة يمكنني من خلالها إنشاء خلية بها زر من الأنواع يؤدي إلى ظهور القائمة المنبثقة "تحديد القائمة البريدية"؟ جيك
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، شكرًا لك على الرمز. هل هناك طريقة يمكنني من خلالها إنشاء زر أمر في Excel ، ثم من خلال النقر على هذا الزر ، يمكن إرسال ورقة Excel نفسها إلى عدة مستلمين كمرفق.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كيف يمكنني القيام بذلك باستخدام خط BCC؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا روبرت
بعد تشغيل الكود ، سيتم فتح نافذة الرسالة الجديدة ، ما عليك سوى إدخال سطر BCC ضمن علامة التبويب الخيار ، انظر الصورة التالية:


أتمنى أن يساعدك ، شكرا لك!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل من طريقة لاستخدام هذا للإرسال من بريد إلكتروني مشترك؟ لا أستطيع أن أقوم بإدراج حقل .SendOnBehalfOf.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أهلاً ! يجب أن أرسل كل شهر نفس البريد الإلكتروني لموفري خدمات مختلفين ، لكن لا ينبغي أن يكونوا في نفس البريد الإلكتروني ..... كيف يمكنني إرسال نفس البريد الإلكتروني لوجهات مختلفة دون أن يكون الجميع في نفس البريد الإلكتروني ؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا فينيسيوس
لإرسال نفس البريد الإلكتروني إلى عدة مستلمين بشكل منفصل ، قد تساعدك المقالة التالية ، يرجى الاطلاع عليها.
https://www.extendoffice.com/documents/excel/3560-excel-send-personalized-email.html
تم تصغير هذا التعليق بواسطة المشرف على الموقع
صباح،


أنا جديد في محاولة الكتابة واستخدام وحدات الماكرو في Excel. كانت محاولتي الأولى هي محاولة إنشاء بريد إلكتروني جماعي لمجموعة فرعية من قائمة رئيسية كبيرة. قمت بقص ولصق الروتين الأول ، ثم حاولت استخدامه ، كل ما فعلته هو إبراز الخلايا التي طلبتها. لم يتم إنشاء بريد إلكتروني في Outlook ، ما الخطأ الذي ارتكبته؟ للتوسع في طلبي الفعلي ، أريد حقًا استهداف رسائل البريد الإلكتروني عن طريق الرمز البريدي أو مجموعات فرعية أخرى. كيف أقوم بإنشاء ماكرو يقوم بالبحث في عمود عن رمز بريدي معين وإنشاء بريد إلكتروني بكل المستلمين الذين تم العثور عليهم؟

شكرا

ستيف
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لدي هذا الرمز ، مشكلتي هي أنه ينشئ بريدًا إلكترونيًا واحدًا لكل مرة لا يكتمل فيها الشرط ، لكني أريد وضع جميع المعلومات التي لا تصل إلى الحالة في بريد إلكتروني واحد فقط

EnviarCorreo ()
خافت OutApp ككائن
تعتيم البريد الخارجي ككائن
خافت ل LastRow As Long
خافت لصف طويل
خافت الإرسال إلى كسلسلة
خافت sSendCC كسلسلة
خافت sSendBCC كسلسلة
خافت s موضوع كسلسلة
خافت sTemp كسلسلة

تعيين OutApp = CreateObject ("Outlook.Application")
OutApp.Session. تسجيل الدخول

قم بتغيير ما يلي حسب الحاجة
sSendTo = ""
sSendCC = ""
sSendBCC = ""
sSubject = "وصل تاريخ الاستحقاق"

تعيين OutMail = OutApp.CreateItem (0)

lLastRow = الخلايا (عدد الصفوف ، 3). النهاية (xlUp). الصف
بالنسبة إلى lRow = 3 إلى lLastRow
إذا كانت الخلايا (lRow، 9) <> "S" ثم
إذا كانت الخلايا (lRow، 2) <= التاريخ ثم

على خطأ استئناف التالي
مع OutMail
.إلى = sSendTo
إذا كان sSendCC> "" ثم .CC = sSendCC
إذا sSendBCC> "" ثم .BCC = sSendBCC
. الموضوع = sSubject

sTemp = "مرحبًا!" & vbCrLf & vbCrLf
sTemp = sTemp & "تم بلوغ تاريخ الاستحقاق"
sTemp = sTemp & "لهذا المشروع:" & vbCrLf & vbCrLf


هذا ما أريد تكراره على جسم البريد الإلكتروني
يفترض أن اسم المشروع موجود في العمود ب
sTemp = sTemp & "المعرف:"
sTemp = sTemp & "" & خلايا (lRow، 1)
sTemp = sTemp & "الوصف:"
sTemp = sTemp & "" & خلايا (lRow، 5)
sTemp = sTemp & "يرجى اتخاذ الإجراء المناسب"
sTemp = sTemp & "الإجراء". & vbCrLf & vbCrLf
sTemp = sTemp & "شكرًا لك!" & vbCrLf
'الى هنا



. الجسم = sTemp
قم بتغيير ما يلي إلى إرسال إذا كنت تريد ذلك
إرسال الرسالة دون المراجعة أولاً
.عرض
انتهت ب
تعيين OutMail = لا شيء

الخلايا (lRow ، 9) = "S"
الخلايا (lRow، 10) = "تم إرسال البريد الإلكتروني في:" & الآن ()
إنهاء حالة
إنهاء حالة
التالي lRow
تعيين OutApp = لا شيء
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل من الممكن استخدام كود اختيار CC من قائمة بنفس الطريقة بعد اختيار TOs؟ باستخدام الكود الحالي ، لا يمكن اختيار أي CCs بنفس الطريقة مثل TOs (العناوين الرئيسية). 
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا يوجين ، سعيد للمساعدة. من الممكن استخدام الكود لاختيار CC من قائمة بنفس الطريقة بعد اختيار TOs. والرمز هو نفسه بشكل أساسي مع كود TOs VBA. يجب إجراء تغيير واحد فقط. فقط قم بتغيير ".To = xEmailAddr" إلى ".Cc = xEmailAddr". يرجى الاطلاع على لقطة الشاشة. ويمكنك اختيار CCs و TOs من قائمة في نفس الوقت. فقط اجعل ".To = xEmailAddr" و ".Cc = xEmailAddr" كلها مضمنة في كود VBA. يرجى لصق الكود التالي في نافذة الوحدة النمطية.
إرسال فرعي متعدد ()
'تحديث بواسطة Extendoffice
خافت xOTApp ككائن
خافت xMItem ككائن
خافت xCell كمجموعة
خافت xRg كمدى
خافت xEmailAddr كسلسلة
خافت xTxt كسلسلة
على خطأ استئناف التالي
xTxt = ActiveWindow.RangeSelection.Address
تعيين xRg = Application.InputBox ("الرجاء تحديد قائمة العناوين:" ، "Kutools for Excel" ، xTxt ، ، ، ، ، ، 8)
إذا كان xRg لا شيء ، فاخرج من Sub
تعيين xOTApp = CreateObject ("Outlook.Application")
لكل xCell في xRg
إذا كان xCell.Value Like "* @ *" إذن
إذا كان xEmailAddr = "" إذن
xEmailAddr = xCell.Value
آخر
xEmailAddr = xEmailAddr & "؛" & xCell.Value
إنهاء حالة
إنهاء حالة
التالى
قم بتعيين xMItem = xOTApp.CreateItem (0)
مع xMItem
. إلى = xEmailAddr
.Cc = xEmailAddr
.عرض
انتهت ب
نهاية الفرعية

آمل أن تتمكن من حل مشكلتك. أتمنى لك نهارا سعيدا مع خالص التقدير ماندي
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أحاول التفوق لإرسال بريد إلكتروني إلى عدة مستلمين ويمكنني الحصول على كل ما أحتاجه ولكنه يرفض وضع عنوان البريد الإلكتروني في مربع TO. هذا هو الكود الذي كنت أعمل معه. هل يمكن لأي شخص مساعدتي في اكتشاف الخطأ الذي أفعله؟ ًشكراً جزيلا!

الماكرو الفرعي 1 ()
خافت rngC الخلية كمجموعة
خافت rngMyDataSet كنطاق
خافت Rng كمدى
خافت OutApp ككائن
تعتيم البريد الخارجي ككائن
خافت البريد الإلكتروني الموضوع كسلسلة
خافت البريد الإلكتروني الإرسال إلى كسلسلة
خافت هيكل البريد كسلسلة
مستلم البريد الإلكتروني الخافت كنطاق
توقيع خافت كسلسلة
Application.ScreenUpdating = خطأ
مع ActiveSheet
إذا كان .FilterMode ثم .ShowAllData
تعيين Rng = .Range ("AK6"، .Cells (.Rows.Count، 1) .End (xlUp))
انتهت ب
لكل rngCell في Rng
إذا rngCell.Offset (0، 6)> 0 ثم

ElseIf rngCell.Offset (0، 5)> تقييم ("اليوم () +7") و _
rngCell.Offset (0، 5) .Value <= قيم ("Today () +30") ثم
rngCell.Offset (0، 6). القيمة = التاريخ

تعيين OutApp = CreateObject ("Outlook.Application")
تعيين OutMail = OutApp.CreateItem (0)

strbody = "وفقًا لسجلاتي ، العقد الخاص بك" & النطاق ("A6"). القيمة & "تستحق المراجعة على" & rngCell.Offset (0 ، 5) .Value & vbNewLine & _
"يرجى مراجعة هذا العقد قبل التاريخ ذي الصلة وإرسال رسالة إلكترونية إليّ تتضمن أي تغييرات تجريها على هذا العقد. إذا تم تجديده ، فيرجى ملء ورقة غلاف العقد التي يمكن العثور عليها في مجلد" الجميع "وإرسال العقد الأصلي الجديد إليّ. "
EmailSendTo = rngCell.Offset (0، 0) .Value
EmailSubject = أوراق ("sheet1"). النطاق ("A6"). القيمة
التوقيع = "C: \ Documents and Settings \" & Environ ("rmm") & _
"\ Application Data \ Microsoft \ Signatures \ rm.htm"
على خطأ استئناف التالي
مع OutMail
. إلى = EmailSendTo
.CC = "hhh@gmail.com"
.BCC = ""
.Subject = EmailSubject
. الجسم = ستربودي
.عرض
Send_Value = Mail_Recipient.Offset (i - 1) .Value
انتهت ب
على خطأ GoTo 0
تعيين OutMail = لا شيء
تعيين OutApp = لا شيء

إنهاء حالة

التالي rngCell
Application.ScreenUpdating = ترو
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا ديانا
ربما يمكنك تطبيق الكود أدناه:

Sub Macro1()
Dim rngCell As Range
Dim Rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
Dim Signature As String
Application.ScreenUpdating = False
On Error Resume Next
With ActiveSheet
  If .FilterMode Then .ShowAllData
  Set Rng = .Range("AK6", .Cells(.Rows.Count, 1).End(xlUp))
End With
Set OutApp = CreateObject("Outlook.Application")
For Each rngCell In Rng
  If rngCell.Offset(0, 6) > 0 Then
    If rngCell.Offset(0, 5).Value > Evaluate("Today() +7") And _
       rngCell.Offset(0, 5).Value <= Evaluate("Today() +30") Then
      rngCell.Offset(0, 6).Value = Date
    End If
    Set OutMail = OutApp.CreateItem(0)
    MailBody = "According to my records, your contract " & Range("A6").Value & " is due for review on " & rngCell.Offset(0, 6).Value & vbNewLine & _
               "Please review this contract prior to the pertinent date and email me with any changes you make to this contract. If it is renewed, " & _
               "please fill out the Contract Cover Sheet which can be found in the Everyone folder and send me the new original contract."
    
    EmailSendTo = rngCell.Offset(2, 6).Value   'Please specify the row and column number of the addresses in the filtered data range,please change the number 2 and 6 to your need
    EmailSubject = Sheets("sheet1").Range("A6").Value
    Signature = "C:\Documents and Settings\" & Environ("rmm") & _
                "\Application Data\Microsoft\Signatures\rm.htm"
    With OutMail
      .To = EmailSendTo
      .CC = "hhh@gmail.com"
      .BCC = ""
      .Subject = EmailSubject
      .Body = MailBody
      .Recipients.ResolveAll
      .Display
    End With
  End If
Next rngCell
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub



EmailSendTo = rngCell.Offset (2، 6) .Value، يجب عليك تغيير الرقم 2 و 6 إلى رقم الصف والعمود بناءً على نطاق البيانات الخاص بك ، يحتوي هذا النطاق على عناوين البريد الإلكتروني التي تريد الإرسال إليها.

من فضلك حاول ، آمل أن يساعدك!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
شكرا لك ولكن للأسف لم تنجح. ما زلت أحصل على نفس النتائج.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا ديانا
في هذه الحالة ، يرجى تقديم لقطة شاشة أو ملف مرفق لبيانات ورقة العمل حتى نتمكن من تحديد مكان المشكلة.
أو يمكنك وصف مشكلتك بشكل أكثر وضوحًا وتفصيلاً.
شكرا!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
يوجد أدناه الرمز الحالي الذي أستخدمه ولكنه لن يضع كل عنوان بريد إلكتروني في مربع TO ، فقط عنوان البريد الإلكتروني الأول في كل منهم. يفعل الشيء نفسه أيضًا مع SUBJECT وفي رسالة البريد الإلكتروني ، يستخدم نفس الشيء مرارًا وتكرارًا. لست متأكدًا من كيفية إرفاق جدول البيانات بهذا البريد الإلكتروني.

الماكرو الفرعي 1 ()
خافت rngC الخلية كمجموعة
خافت rngMyDataSet كنطاق
خافت Rng كمدى
خافت OutApp ككائن
تعتيم البريد الخارجي ككائن
خافت البريد الإلكتروني الموضوع كسلسلة
خافت البريد الإلكتروني الإرسال إلى كسلسلة
تعتيم MailBody كنطاق
مستلم البريد الإلكتروني الخافت كنطاق
توقيع خافت كسلسلة
Application.ScreenUpdating = خطأ
مع ActiveSheet
إذا كان .FilterMode ثم .ShowAllData
تعيين Rng = .Range ("AJ6"، .Cells (.Rows.Count، 1) .End (xlUp))
انتهت ب
لكل rngCell في Rng
إذا rngCell.Offset (0، 6)> 0 ثم

ElseIf rngCell.Offset (0، 5)> تقييم ("اليوم () +7") و _
rngCell.Offset (0، 5) .Value <= قيم ("Today () +120") ثم
rngCell.Offset (0، 6). القيمة = التاريخ

تعيين OutApp = CreateObject ("Outlook.Application")
تعيين OutMail = OutApp.CreateItem (0)

strbody = "وفقًا لسجلاتي ،" & المدى الخاص بك ("A6"). القيمة & "العقد مستحق للمراجعة" & rngCell.Offset (0 ، 5) .Value & _
". من المهم أن تراجع هذا العقد في أسرع وقت ممكن وأن ترسل إليّ بريدًا إلكترونيًا يتضمن أي تغييرات تم إجراؤها. إذا تم تجديده ، فيرجى ملء ورقة غلاف العقد التي يمكن العثور عليها في مجلد" الجميع "وإرسال ورقة الغلاف إلي مع العقد الأصلي الجديد . "
EmailSendTo = Sheets ("sheet1"). المدى ("AJ6"). القيمة
EmailSubject = أوراق ("sheet1"). النطاق ("A6"). القيمة
التوقيع = "C: \ Documents and Settings \" & Environ ("rmm") & _
"\ Application Data \ Microsoft \ Signatures \ rm.htm"
على خطأ استئناف التالي
مع OutMail
. إلى = EmailSendTo
.CC = "hhh@gmail.com"
.BCC = ""
.Subject = EmailSubject
. الجسم = ستربودي
.عرض
Send_Value = Mail_Recipient.Offset (i - 1) .Value
انتهت ب
على خطأ GoTo 0
تعيين OutMail = لا شيء
تعيين OutApp = لا شيء

إنهاء حالة

التالي rngCell
Application.ScreenUpdating = ترو
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،
يمكنك إدراج المصنف الخاص بك كمرفق هنا ، يرجى الاطلاع على لقطة الشاشة أدناه:
https://www.extendoffice.com/images/stories/comments/comment-skyyang/doc-attachment-1.png
شكرا!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لا يوجد مربع "تحميل المرفق" على طرفي.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا ديانا
إذا لم يكن هناك مربع "تحميل المرفق" ، فيجب عليك التسجيل أولاً ، ثم سيظهر خيار "تحميل المرفق".
للتسجيل ، يرجى الانتقال إلى أعلى المقالة ، والنقر فوق إعادة التسجيل زر لبدء.
https://www.extendoffice.com/images/stories/comments/comment-skyyang/doc-register.png
انا اسف على الازعاج.
لا توجد تعليقات منشورة هنا حتى الآن
اترك تعليقاتك
النشر كضيف
×
قيم المنشور:
0   الشخصيات
المواقع المقترحة

تواصل معنا

حقوق التأليف والنشر © 2009 - شبكة الاتصالات العالمية.extendoffice.com. | كل الحقوق محفوظة. مشغل بواسطة ExtendOffice. | | خريطة الموقع
Microsoft وشعار Office هما علامتان تجاريتان أو علامتان تجاريتان مسجلتان لشركة Microsoft Corporation في الولايات المتحدة و / أو دول أخرى.
محمي بواسطة Sectigo SSL