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

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

لنفترض أنك تريد إرسال بريد إلكتروني مباشرة في Excel ، كيف يمكنك إضافة توقيع Outlook الافتراضي في البريد الإلكتروني؟ توفر هذه المقالة طريقتين لمساعدتك في إضافة توقيع Outlook عند إرسال بريد إلكتروني في Excel.

أدخل التوقيع في بريد Outlook الإلكتروني عند الإرسال عن طريق Excel VBA
أدخل توقيع Outlook بسهولة عند إرسال بريد إلكتروني في Excel باستخدام أداة رائعة

المزيد من البرامج التعليمية لإرسالها بالبريد في Excel ...


أدخل التوقيع في بريد Outlook الإلكتروني عند الإرسال عن طريق Excel VBA

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

1. افتح ورقة العمل التي تحتوي على قائمة عناوين البريد الإلكتروني التي تريد إرسالها بالبريد الإلكتروني ، ثم اضغط على قديم + F11 مفاتيح.

2. في الافتتاح ميكروسوفت فيسوال باسيك للتطبيقات الإطار، انقر فوق إدراج > وحدة، ثم انسخ ما يلي VBA 2 في نافذة كود الوحدة النمطية.

3. الآن أنت بحاجة إلى استبدال ملف .الجسم في الخط VBA 2 مع الكود في VBA 1. بعد ذلك ، انقل الخط .عرض تحت الخط مع xMailOut.

VBA 1: قالب إرسال رسائل البريد الإلكتروني مع توقيع Outlook الافتراضي في Excel

.HTMLBody = "This is a test email sending in Excel" & "<br>" & .HTMLBody

فبا 2: إرسال بريد إلكتروني إلى عناوين البريد الإلكتروني المحددة في الخلايا في إكسيل

Sub SendEmailToAddressInCells()
    Dim xRg As Range
    Dim xRgEach As Range
    Dim xRgVal As String
    Dim xAddress As String
    Dim xOutApp As Outlook.Application
    Dim xMailOut As Outlook.MailItem
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select email address range", "KuTools For Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xOutApp = CreateObject("Outlook.Application")
    Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
    For Each xRgEach In xRg
        xRgVal = xRgEach.Value
        If xRgVal Like "?*@?*.?*" Then
            Set xMailOut = xOutApp.CreateItem(olMailItem)
            With xMailOut
                .To = xRgVal
                .Subject = "Test"
                .Body = "Dear " _
                      & vbNewLine & vbNewLine & _
                        "This is a test email " & _
                        "sending in Excel"
                .Display
                '.Send
            End With
        End If
    Next
    Set xMailOut = Nothing
    Set xOutApp = Nothing
    Application.ScreenUpdating = True
End Sub

يمكن أن تساعدك لقطة الشاشة التالية في العثور بسهولة على الاختلافات بعد تغيير رمز VBA.

4. اضغط على F5 مفتاح لتشغيل الكود. ثم كوتولس ل إكسيل حدد مربع ينبثق ، يرجى تحديد عناوين البريد الإلكتروني التي سترسل إليها رسائل البريد الإلكتروني ، ثم انقر فوق حسنا.

ثم يتم إنشاء رسائل البريد الإلكتروني. يمكنك رؤية توقيع Outlook الافتراضي مضافًا في نهاية نص البريد الإلكتروني.

نصيحة:

  • 1. يمكنك تغيير نص البريد الإلكتروني في رمز VBA 1 بناءً على احتياجاتك.
  • 2. بعد تشغيل الرمز ، إذا انبثق مربع حوار خطأ يحذر من أن النوع المحدد من قبل المستخدم غير محدد ، يرجى إغلاق مربع الحوار هذا ، ثم الانتقال للنقر الأدوات > المحلية في ال ميكروسوفت فيسوال باسيك للتطبيقات نافذة او شباك. في الافتتاح المراجع - VBAProject النافذة ، تحقق من مكتبة كائنات Microsoft Outlook مربع وانقر حسنا. ثم قم بتشغيل الكود مرة أخرى.

أدخل توقيع Outlook بسهولة عند إرسال بريد إلكتروني في Excel باستخدام أداة رائعة

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

قبل التطبيق كوتولس ل إكسيلالرجاء قم بتنزيله وتثبيته أولاً.

أولاً ، تحتاج إلى إنشاء قائمة بريدية بحقول مختلفة سوف ترسل رسائل بريد إلكتروني بناءً عليها.

يمكنك إنشاء قائمة بريدية يدويًا حسب حاجتك أو تطبيق ميزة إنشاء قائمة بريدية لإنجاز ذلك بسرعة.

1. انقر كوتولس بلس > إنشاء قائمة بريدية.

2. في ال إنشاء قائمة بريدية مربع الحوار ، وحدد الحقول التي تريدها ، واختر مكان إخراج القائمة ، ثم انقر فوق OK .

3. الآن يتم إنشاء عينة قائمة بريدية. نظرًا لأنها قائمة عينة ، فأنت بحاجة إلى تغيير الحقول إلى محتوى مطلوب معين. (مسموح بعدة صفوف)

4. بعد ذلك ، حدد القائمة بأكملها (بما في ذلك الرؤوس) ، انقر فوق كوتولس بلس > إرسال رسائل البريد الإلكتروني.

5. في ال إرسال رسائل البريد الإلكتروني صندوق المحادثة:

  • 5.1) يتم وضع العناصر الموجودة في القائمة البريدية المحددة في الحقول المقابلة تلقائيًا ؛
  • 5.2) إنهاء نص البريد الإلكتروني ؛
  • 5.3) تحقق من كل من أرسل بريدًا إلكترونيًا عبر Outlook و استخدم إعدادات توقيع Outlook مربعات؛
  • شنومكس) انقر فوق إرسال زر. انظر لقطة الشاشة:

الآن يتم إرسال رسائل البريد الإلكتروني. ويتم إضافة توقيع Outlook الافتراضي في نهاية نص البريد الإلكتروني.

  إذا كنت ترغب في الحصول على نسخة تجريبية مجانية (30-يوم) من هذه الأداة ، الرجاء الضغط لتنزيلهثم انتقل لتطبيق العملية حسب الخطوات المذكورة أعلاه.


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

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

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

إرسال بريد إلكتروني مع مرفقات متعددة مرفقة في Excel
تتحدث هذه المقالة عن إرسال بريد إلكتروني من خلال Outlook مع مرفقات متعددة مرفقة في Excel.

أرسل بريدًا إلكترونيًا إذا تم الوفاء بتاريخ الاستحقاق في Excel
على سبيل المثال ، إذا كان تاريخ الاستحقاق في العمود C أقل من أو يساوي 7 أيام (التاريخ الحالي هو 2017/9/13) ، فأرسل تذكيرًا بالبريد الإلكتروني إلى المستلم المحدد في العمود A بمحتوى محدد في العمود B. كيف أنجزه؟ ستوفر هذه المقالة طريقة VBA للتعامل معها بالتفصيل.

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

المزيد من البرامج التعليمية لإرسالها بالبريد في Excel ...


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

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٪ ، ويقلل مئات النقرات بالماوس كل يوم!
أوفيسيتاب القاع
فرز التعليقات حسب
التعليقات (29)
لا يوجد تقييم. كن أول من يقيم!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
شكراً جزيلاً لك ، أنقذت حياتي بهذا القالب: د
تم تصغير هذا التعليق بواسطة المشرف على الموقع
عزيزي فافيو ،
سعيد للمساعدة.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لا يعمل مع المرفقات في Office 2016
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مكان العبادة،
يمكن أن يساعدك رمز VBA أدناه. بعد تشغيل الرمز ، يرجى تحديد الخلايا التي تحتوي على عناوين البريد الإلكتروني التي سترسل إليها رسائل البريد الإلكتروني ، ثم حدد الملفات التي تريد إرفاقها في البريد الإلكتروني كمرفقات عند ظهور مربع الحوار الثاني. وسيتم عرض توقيع Outlook الافتراضي في نص البريد الإلكتروني أيضًا. شكرا لك على تعليقك.

Sub SendEmailToAddressInCells ()
خافت xRg كمدى
خافت xRgEach كنطاق
خافت xRgVal كسلسلة
Dim xAddress As String
خافت xOutApp باسم Outlook
تعتيم xMailOut كـ Outlook.MailItem
على خطأ استئناف التالي
xAddress = ActiveWindow.RangeSelection.Address
تعيين xRg = Application.InputBox ("الرجاء تحديد نطاق عنوان البريد الإلكتروني" ، "KuTools For Excel" ، xAddress ، ، ، ، ، ، 8)
إذا كان xRg لا شيء ، فاخرج من Sub
Application.ScreenUpdating = خطأ
تعيين xOutApp = CreateObject ("Outlook.Application")
تعيين xRg = xRg.SpecialCells (xlCellTypeConstants ، xlTextValues)
قم بتعيين xFileDlg = Application.FileDialog (msoFileDialogFilePicker)
إذا كان xFileDlg.Show = -1 ثم
لكل xRgEach في xRg
xRgVal = xRgEach.Value
إذا كان xRgVal مثل "؟*@؟*.؟*" ثم
قم بتعيين xMailOut = xOutApp.CreateItem (olMailItem)
مع xMailOut
.عرض
إلى = xRgVal
.Subject = "اختبار"
.HTMLBody = "إرسال بريد إلكتروني تجريبي في Excel" & "
"& .HTMLBody
لكل xFileDlgItem في xFileDlg.SelectedItems
المرفقات. إضافة xFileDlgItem
التالي xFileDlgItem
'.يرسل
انتهت ب
إنهاء حالة
التالى
تعيين xMailOut = لا شيء
تعيين xOutApp = لا شيء
Application.ScreenUpdating = ترو
إنهاء حالة
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أحاول إضافة توقيع Outlook بعنوان "افتراضي" ولكن لا يبدو أنه يعمل.
يمكنك الرجاء المساعدة؟ أعتقد أن منطق "xMailout" لديّ خاطئ. هذه هي منطقتي الخاطئة المشتبه بها.

أمر فرعي خاص

خافت xOutApp ككائن
تعتيم xOutMail ككائن
خافت xMailBody كسلسلة
تعتيم xMailOut كـ Outlook.MailItem
على خطأ استئناف التالي
تعيين xOutApp = CreateObject ("Outlook.Application")
قم بتعيين xOutMail = xOutApp.CreateItem (0)
xMailBody = "تحياتي:" & vbNewLine & vbNewLine & _
"هذا هو السطر 1" & vbNewLine & _
"هذا هو السطر 2" & vbNewLine & _
"هذا هو السطر 3" & vbNewLine & _
"هذا هو السطر 4"
على خطأ استئناف التالي
مع xOutMail
.To = "Email.here.com"
.CC = "Email.here.com"
.Subject = "عنوان البريد الإلكتروني هنا -" & المدى ("رقم الخلية"). القيمة
. الجسم = xMailBody
. المرفقات.إضافة ActiveWorkbook.FullName
قم بتعيين xMailOut = xOutApp.CreateItem (olMailItem)
مع xMailOut
.عرض
انتهت ب
ActiveWorkbook. حفظ
على خطأ GoTo 0
تعيين xOutMail = لا شيء
تعيين xOutApp = لا شيء
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
يوم جيد،
تم تعديل البرنامج النصي الخاص بك ، يرجى المحاولة. شكرًا لك.

أمر فرعي خاص
خافت xOutApp ككائن
تعتيم xOutMail ككائن
خافت xMailBody كسلسلة
تعتيم xMailOut كـ Outlook.MailItem
على خطأ استئناف التالي
تعيين xOutApp = CreateObject ("Outlook.Application")
قم بتعيين xOutMail = xOutApp.CreateItem (0)
xMailBody = "تحياتي:" & vbNewLine & vbNewLine & _
"هذا هو السطر 1" & vbNewLine & _
"هذا هو السطر 2" & vbNewLine & _
"هذا هو السطر 3" & vbNewLine & _
"هذا هو السطر 4"
على خطأ استئناف التالي
مع xOutMail
.To = "Email.here.com"
.CC = "Email.here.com"
.Subject = "عنوان البريد الإلكتروني هنا -" & المدى ("رقم الخلية"). القيمة
. الجسم = xMailBody
المرفقات.إضافة ActiveWorkbook.FullName
قم بتعيين xMailOut = xOutApp.CreateItem (olMailItem)
مع xMailOut
.عرض
انتهت ب
انتهت ب
ActiveWorkbook. حفظ
على خطأ GoTo 0
تعيين xOutMail = لا شيء
تعيين xOutApp = لا شيء
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كيفية إضافة التوقيع إذا تم استخدام الماكرو من قبل مستخدمين متعددين.
على سبيل المثال ، سيتم تشغيل الماكرو الخاص بي بواسطة 3 أشخاص آخرين أيضًا. فكيف يمكن للماكرو استخدام توقيع المستخدم الذي يقوم بتشغيل الماكرو.
شكرا مقدما
تم تصغير هذا التعليق بواسطة المشرف على الموقع
يوم جيد،
يمكن أن يتعرف رمز VBA تلقائيًا على التوقيع الافتراضي في Outlook الخاص بالمرسل ، ويرسل بريدًا إلكترونيًا بتوقيعه الخاص من خلال Outlook.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
إذا كان نص جسدي مرتبطًا بالسحب من حقول Excel ، فإن استخدام & .HTMLBody في نهاية السلسلة يمحو كل النص الأساسي ويترك التوقيع فقط.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أواجه مشكلة في تشغيل هذا في excel 2016. تظهر لي رسالة "خطأ في الترجمة: نوع محدد من قبل المستخدم غير محدد". الرجاء المساعدة!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
رائع!!!!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
شكرا جزيلا ...
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، سأحتاج إلى مساعدة في الماكرو الخاص بي ، أحتاج إلى إدراج توقيع Outlook أسفل الجدول ، هل يمكنك مساعدتي في ذلك؟

أمر فرعي خاص


النظرة القاتمة ككائن
خافت البريد الإلكتروني الجديد ككائن
خافت xInspect ككائن
خافت للصفحة محرر ككائن

تعيين التوقعات = CreateObject ("Outlook.Application")
تعيين newEmail = outlook.CreateItem (0)

مع البريد الإلكتروني الجديد
.To = Sheet5.Range ("F1")
.CC = ""
.BCC = ""
.Subject = Sheet5.Range ("B5")
.Body = Sheet5.Range ("B41")
.عرض

قم بتعيين xInspect = newEmail.GetInspector
اضبط pageEditor = xInspect.WordEditor

الورقة 5.Range ("B6: I7"). نسخ

pageEditor.Application.Selection.Start = Len (. Body)
pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)

.عرض
تعيين pageEditor = لا شيء
تعيين xInspect = لا شيء
انتهت ب

تعيين newEmail = لا شيء
تعيين التوقعات = لا شيء

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


مرحبا العالم الفرعي ()
خافت OutApp ككائن
تعتيم البريد الخارجي ككائن
الخلية المعتمة كنطاق
مسار خافت كسلسلة
المسار = Application.ActiveWorkbook.Path
تعيين OutApp = CreateObject ("Outlook.Application")

لكل خلية في النطاق ("C4: C6")
تعيين OutMail = OutApp.CreateItem (0)
مع OutMail
.عرض
إلى = الخلية القيمة
.Subject = خلايا (cell.Row ، "D"). القيمة
.HTMLBody = "عزيزي" & الخلايا (cell.Row، "B"). القيمة & "،" _
& vbNewLine & vbNewLine & _
"ترحيب دافئ" _
& vbNewLine & vbNewLine & _
"نحن ، JK Overseas ، نود أن ننتهز الفرصة ونقدم شركتنا JK Overseas ، التي تشارك في أعمال الملح على مدار السنوات الثلاث الماضية. نحن حاليًا أقوياء في الداخل والتوسع في الخارج. نحن مورد ملح الطعام ، ملح عسر الماء ، ملح إزالة الجليد ، ملح صناعي "&". " _
& vbNewLine & vbNewLine & _
"لدينا شراكة مع الشركات المصنعة على نطاق واسع في الهند ونشتري منها الملح عالي الجودة والصادرات. لذلك ، نحن نبحث عن مستورد خبير موثوق به وكذلك وكيل موزع للقيام بعمل طويل الأجل مع المنفعة المتبادلة" & " . " _
& vbNewLine & vbNewLine & _
"يرجى الاتصال بنا لإبلاغنا بمتطلباتك أو لأي استفسارات أخرى قد تكون لديك. نحن نقدم خدمات لوجستية موثوقة والتسليم في الوقت المحدد. نحن على ثقة من أن أسعارنا الأكثر تنافسية سوف تتوافق مع توقعاتك". " _
& vbNewLine & vbNewLine & _
.HTMLBody

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

Public Sub CheckAndSendMail ()

'تم التحديث بواسطة Extendoffice 2018 / 11 / 22

خافت xRg التاريخ كنطاق

خافت xRg إرسال كمدى

خافت xRgText كنطاق

خافت xRg تم تنفيذه كنطاق

خافت xOutApp ككائن

خافت xMailItem ككائن

خافت xLastRow طويل

خافت vbCrLf كسلسلة

خافت xMailBody كسلسلة

خافت xRgDateVal كسلسلة

خافت xRgSendVal كسلسلة

خافت xMailSubject كسلسلة

أنا خافت وطويلة

على خطأ استئناف التالي

الرجاء تحديد نطاق تاريخ الاستحقاق

xStrRang = "D2: D110"

تعيين xRgDate = النطاق (xStrRang)

الرجاء تحديد نطاق عناوين البريد الإلكتروني للمستلمين

xStrRang = "C2: C110"

تعيين xRgSend = النطاق (xStrRang)

xStrRang = "A2: A110"

تعيين xRgName = النطاق (xStrRang)

حدد النطاق بالمحتوى المذكَّر في بريدك الإلكتروني

xStrRang = "Z2: Z110"

تعيين xRgText = النطاق (xStrRang)

xLastRow = xRgDate.Rows.Count

تعيين xRgDate = xRgDate (1)

تعيين xRgSend = xRgSend (1)

تعيين xRgName = xRgName (1)

تعيين xRgText = xRgText (1)

تعيين xOutApp = CreateObject ("Outlook.Application")

لأني = 1 إلى xLastRow

xRgDateVal = ""

xRgDateVal = xRgDate.Offset (I - 1) .Value

إذا كان xRgDateVal <> "" ثم

إذا كان CDate (xRgDateVal) - التاريخ <= 30 و CDate (xRgDateVal) - التاريخ> 0 ثم

xRgSendVal = xRgSend.Offset (I - 1) .Value

xMailSubject = "تنتهي صلاحية اتفاقية خدمة JBC في" & xRgDateVal

vbCrLf = "

"

xMailBody = ""

xMailBody = xMailBody & "عزيزي" & xRgName.Offset (I - 1) .Value & vbCrLf

xMailBody = xMailBody & "" & xRgText.Offset (I - 1) .Value & vbCrLf

xMailBody = xMailBody & ""

قم بتعيين xMailItem = xOutApp.CreateItem (0)

مع xMailItem

. الموضوع = xMailSubject

إلى = xRgSendVal

.CC = "mailcc@justbettercare.com"

.HTMLBody = xMailBody

.عرض

'.يرسل

انتهت ب

تعيين xMailItem = لا شيء

إنهاء حالة

إنهاء حالة

التالى

تعيين xOutApp = لا شيء

نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
إنه رمز مفيد حقًا
أحتاج إلى تغيير تنسيق النص من اليمين إلى اليسار في سطر xOutMsg
ساعدنى من فضلك .
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أحاول إرسال أوراق فردية من برنامج Excel إلى رسائل بريد إلكتروني مختلفة ، ولكن سيتم إرفاق المصنف نفسه فقط. أيضًا ، يجب أن تكون قادرًا على إضافة سطر التوقيع الخاص بي. هل من مساعدة؟ Sub AST_Email_From_Excel ()

تطبيق البريد الإلكتروني الخافت ككائن
خافت البريد الإلكترونيالبند ككائن

تعيين emailApplication = CreateObject ("Outlook.Application")
تعيين emailItem = emailApplication.CreateItem (0)

الآن نحن نبني البريد الإلكتروني.

emailItem.to = المدى ("e2"). القيمة

emailItem.CC = النطاق ("g2"). القيمة

emailItem.Subject = "معدات Techquidation التي لم يتم إرجاعها"

emailItem.Body = "راجع جدول البيانات المرفق للعناصر التي لم يتم إرجاعها في منطقتك"

إرفاق المصنف الحالي
emailItem.Attachments.Add ActiveWorkbook.FullName

قم بإرفاق أي ملف من جهاز الكمبيوتر الخاص بك.
'emailItem.Attachments.Add ("C: \ ...)"

أرسل البريد الإلكتروني
'emailItem.send

اعرض البريد الإلكتروني حتى يتمكن المستخدم من تغييره حسب الرغبة قبل الإرسال
البريد الإلكتروني

تعيين emailItem = لا شيء
تعيين emailApplication = لا شيء

نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا كريس ، تم تعديل الكود الذي قدمته. يمكن الآن إدراج توقيع Outlook في نص الرسالة. يرجى محاولة إعطائها. شكرًا لك. AST_Email_From_Excel فرعي ()
'تم التحديث بواسطة Extendoffice 20220211
تطبيق البريد الإلكتروني الخافت ككائن
خافت البريد الإلكترونيالبند ككائن
تعيين emailApplication = CreateObject ("Outlook.Application")
تعيين emailItem = emailApplication.CreateItem (0)

الآن نحن نبني البريد الإلكتروني.
emailItem.Display "عرض البريد الإلكتروني بحيث يمكن للمستخدم تغييره حسب الرغبة قبل الإرسال
emailItem.to = المدى ("e2"). القيمة
emailItem.CC = النطاق ("g2"). القيمة
emailItem.Subject = "معدات Techquidation التي لم يتم إرجاعها"
emailItem.HTMLBody = "راجع جدول البيانات المرفق للعناصر التي لم يتم إرجاعها في منطقتك" & " & emailItem.HTMLBody

إرفاق المصنف الحالي
emailItem.Attachments.Add ActiveWorkbook.FullName

تعيين emailItem = لا شيء
تعيين emailApplication = لا شيء

نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا كريستال ، شكرًا لك على جعله يضيف التوقيع ، لا يبدو أنه معجب بقسم HTMLBody. عندما أقوم بتشغيل الماكرو ، فإنه يصحح الأخطاء على emailItem.HTMLBody = "انظر جدول البيانات المرفق للعناصر التي لم يتم إرجاعها في منطقتك" & " & emailItem.HTMLBodyand لا يكمل الباقي.  
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،
ما هو إصدار Excel الذي تستخدمه؟ يمكن أن يساعد رمز VBA التالي أيضًا. يرجى محاولة إعطائها. شكرا لملاحظاتك. Sub SendWorkSheet ()
'تحديث بواسطة Extendoffice 20220218
خافت x ملف كسلسلة
Dim xFormat As Long
Dim Wb كمصنف
خافت Wb2 كمصنف
خافت مسار ملف كسلسلة
خافت اسم الملف كسلسلة
تعتيم OutlookApp ككائن
تعتيم OutlookMail ككائن
على خطأ استئناف التالي
Application.ScreenUpdating = خطأ
تعيين Wb = Application.ActiveWorkbook
ActiveSheet.Copy
قم بتعيين Wb2 = Application.ActiveWorkbook
حدد حالة Wb.FileFormat
حالة xlOpenXML
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
حالة xlOpenXMLWorkbookMacroEnabled:
إذا كان Wb2.HasVBProject ثم
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
آخر
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
إنهاء حالة
حالة Excel8:
xFile = ".xls"
xFormat = Excel8
الحالة xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
إنهاء اختر
FilePath = Environ $ ("temp") & "\"
FileName = Wb.Name & Format (الآن ، "dd-mmm-yy h-mm-ss")
تعيين OutlookApp = CreateObject ("Outlook.Application")
تعيين OutlookMail = OutlookApp.CreateItem (0)
Wb2.SaveAs FilePath & FileName & xFile، FileFormat: = xFormat
'xstr = Range ("e2") & "؛" & Range ("g2")
مع OutlookMail
.عرض
.To = المدى ("e2")
.CC = النطاق ("g2")
.BCC = ""
.Subject = "معدات Techquidation التي لم يتم إرجاعها"
.HTMLBody = "راجع جدول البيانات المرفق للعناصر التي لم يتم إرجاعها في منطقتك" & " "& .HTMLBody
المرفقات أضف Wb2.FullName
'.يرسل
انتهت ب
Wb2. إغلاق
اقتل مسار الملف & اسم الملف & xFile
تعيين OutlookMail = لا شيء
تعيين OutlookApp = لا شيء
Application.ScreenUpdating = ترو
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
يبدو أنه Excel 2016 و VBA 7.1
تم تصغير هذا التعليق بواسطة المشرف على الموقع
Oi Cristal ، وهو ماكرو minha perde a configuração da assinatura do e-mail ، com imagens e formatação original. كومو كونسيجو محلل؟

Sub Geraremail ()

خافت OLapp كـ Outlook
Dim janela As Outlook.MailItem

تعيين OLapp = تطبيق Outlook الجديد
تعيين جانيلا = OLapp.CreateItem (olMailItem)

Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"


مع جانيلا
ActiveWorkbook. حفظ
.عرض
.To = Sheets ("Base"). Range ("A2"). القيمة
.CC = Sheets ("Base"). Range ("A5"). القيمة
.Subject = "Mapa - Acrilo" & Format (التاريخ ، "dd.mm.yy")
assinatura =. الجسم
.Body = "Prezados / as"، & Chr (10) & Chr (10) & "يعتبر Segue anexo o mapa de Acrilonitrila بمثابة بائعين سابقين لا يوجد S&OP." & مركز حقوق الإنسان (10) & مركز حقوق الإنسان (10) & أسيناتورا
المرفقات إضافة Anexo01
انتهت ب

نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
Com a mudança abaixo، consegui ajustar. Porém a letra do corpo da mensagem fica em Times New Roman. Gostaria de usar Calibri، como posso alterar o código؟

Sub Geraremail ()

خافت OLapp كـ Outlook
Dim janela As Outlook.MailItem

تعيين OLapp = تطبيق Outlook الجديد
تعيين جانيلا = OLapp.CreateItem (olMailItem)

Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"


مع جانيلا
ActiveWorkbook. حفظ
.عرض
.To = Sheets ("Base"). Range ("A2"). القيمة
.CC = Sheets ("Base"). Range ("A5"). القيمة
.Subject = "Mapa - Acrilo" & Format (التاريخ ، "dd.mm.yy")
assinatura =. الجسم
.HTMLBody = "Prezados / as"، & Chr (10) & Chr (10) & "Segue anexo o mapa de Acrilonitrila يعتبر ذلك بمثابة بائعين سابقين لا يوجد S&OP." & " "& .HTMLBody
المرفقات إضافة Anexo01
انتهت ب

نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا ميلا ،
يمكن أن يساعدك رمز VBA التالي في تغيير خط نص البريد الإلكتروني إلى Calibri ، يرجى تجربته. شكرًا لك.
قبل تشغيل الكود ، تحتاج إلى النقر فوق الأدوات > الرقم المرجعي في ال ميكروسوفت فيسوال باسيك للتطبيقات نافذة ، ثم تحقق من مكتبة كائنات Microsoft Word مربع الاختيار في المراجع - VBAProject مربع الحوار كما هو موضح أدناه.
[img] I: \ 工作 \ 周雪明 \ 2022 年 工作 \ 6 月份 \ 文章 评论 截图 \ 3.png [/ img]
Sub Geraremail()
Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem
Dim xDoc As Document 'Click Tools > Reference to enable the Microsoft Word Object Library
On Error Resume Next
Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)
Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"
With janela
  ActiveWorkbook.Save
  .Display
  .To = Sheets("Base").Range("A2").Value
  .CC = Sheets("Base").Range("A5").Value
  .Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
   assinatura = .Body
  .HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
  .Attachments.Add Anexo01
End With
Set xDoc = janela.GetInspector.WordEditor
xDoc.Content.Font.Name = "Calibri"
End Sub
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا ميلا ،
يمكن أن يساعدك رمز VBA التالي في تغيير خط نص البريد الإلكتروني إلى Calibri ، يرجى تجربته. شكرًا لك.
قبل تشغيل الكود ، تحتاج إلى النقر فوق الأدوات > الرقم المرجعي في ال ميكروسوفت فيسوال باسيك للتطبيقات نافذة ، ثم تحقق من مكتبة كائنات Microsoft Word مربع الاختيار في المراجع - VBAProject مربع الحوار كملف مرفق موضح أدناه.
Sub Geraremail()
Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem
Dim xDoc As Document 'Click Tools > Reference to enable the Microsoft Word Object Library
On Error Resume Next
Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)
Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"
With janela
  ActiveWorkbook.Save
  .Display
  .To = Sheets("Base").Range("A2").Value
  .CC = Sheets("Base").Range("A5").Value
  .Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
   assinatura = .Body
  .HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
  .Attachments.Add Anexo01
End With
Set xDoc = janela.GetInspector.WordEditor
xDoc.Content.Font.Name = "Calibri"
End Sub
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، أحاول إصلاح رمز VBA الخاص بي. أرغب في تضمين أحد توقيعي في التوقعات مع شعار. هل هذا ممكن ، وأين أضع الكود الذي أستخدمه حاليًا؟ اي مساعدة ستكون جيدة.

Sub EmailAspdf ()

خافت EApp ككائن
تعيين EApp = CreateObject ("Outlook.Application")

عنصر خافت ككائن
تعيين EItem = EApp.CreateItem (0)

Dim invno كما طويل
خافت كاسم كسلسلة
قاتمة amt كعملة
خافت dt_issue كتاريخ
مصطلح خافت كما بايت
خافت nextrec كمجموعة
مسار خافت كسلسلة
خافت fname كسلسلة

invno = المدى ("I4")
custname = النطاق ("A11")
amt = المدى ("I42")
dt_issue = المدى ("I6")
المصطلح = المدى ("I7")
المسار = "مايباث"
fname = invno & "-" & custname

ActiveSheet.ExportAsFixedFormat Type: = xlTypePDF، IgnorePrintAreas: = False، Filename: = path & fname

تعيين nextrec = Sheet3.Range ("A1048576"). End (xlUp). Offset (1، 0)

nextrec = invno
nextrec.Offset (0، 1) = custname
nextrec.Offset (0، 2) = amt
nextrec.Offset (0، 3) = dt_issue
nextrec.Offset (0، 4) = dt_issue + term
nextrec.Offset (0 ، 8) = الآن

Sheet3.Hyperlinks.Add anchor: = nextrec.Offset (0، 6)، Address: = path & fname & ".pdf"

مع EItem

. إلى = المدى ("A17")

.Subject = Range ("A11") & "" & "رقم الفاتورة:" & Range ("I4") & "" & "for California Advocates"

.body = "Hello" & Range ("A11") & "،" & vbNewLine & vbNewLine _
& "يرجى الاطلاع على الفاتورة المرفقة لـ" & Range ("A11") & "." & vbNewLine & vbNewLine _
& "إذا كانت لديك أي أسئلة ، فيرجى عدم التردد في الاتصال بي." & vbNewLine & vbNewLine _
& "أفضل" & vbNewLine _
& "Mynamehere" & vbNewLine

.Attachments.Add (path & fname & ".pdf")

.عرض

انتهت ب
خروج الفرعية



نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا RoseAnne ،

يمكنك إضافة الشعار يدويًا إلى توقيعك مسبقًا قبل تطبيق رمز VBA. يجب وضع الكود في نافذة كود الوحدة النمطية (اضغط على Alt + F11 لفتح محرر Visual Basic ، انقر فوق إدراج> وحدة)
لا توجد تعليقات منشورة هنا حتى الآن
اترك تعليقاتك
النشر كضيف
×
قيم المنشور:
0   الشخصيات
المواقع المقترحة

تواصل معنا

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