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

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

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

سيتيح لك الكود التالي لـ VBA إرسال كل ورقة عمل كمرفق إلى المستلم المقابل المدرج في الخلية S1. يرجى اتباع الخطوات التالية:

1. اضغط على مفتاح Alt+ F11 معًا لفتح نافذة Microsoft Visual Basic for Applications.

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

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

Sub Mail_Every_Worksheet()
'Updateby ExtendOffice
  Dim xWs As Worksheet
  Dim xWb As Workbook
  Dim xFileExt As String
  Dim xFileFormatNum As Long
  Dim xTempFilePath As String
  Dim xFileName As String
  Dim xOlApp As Object
  Dim xMailObj As Object
  On Error Resume Next
  With Application
      .ScreenUpdating = False
      .EnableEvents = False
  End With
  xTempFilePath = Environ$("temp") & "\"
  If Val(Application.Version) < 12 Then
    xFileExt = ".xls": xFileFormatNum = -4143
  Else
    xFileExt = ".xlsm": xFileFormatNum = 52
  End If
  Set xOlApp = CreateObject("Outlook.Application")
  For Each xWs In ThisWorkbook.Worksheets
    If xWs.Range("S1").Value Like "?*@?*.?*" Then
      xWs.Copy
      Set xWb = ActiveWorkbook
      xFileName = xWs.Name & " of " _
                   & VBA.Left(ThisWorkbook.Name, VBA.InStr(ThisWorkbook.Name, ".") - 1) & " "
      Set xMailObj = xOlApp.CreateItem(0)
      xWb.Sheets.Item(1).Range("S1").Value = ""
      With xWb
        .SaveAs xTempFilePath & xFileName & xFileExt, FileFormat:=xFileFormatNum
        With xMailObj
        'specify the CC, BCC, Subject, Body below
            .To = xWs.Range("S1").Value
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Hi there"
            .Attachments.Add xWb.FullName
            .Display
        End With
        .Close SaveChanges:=False
      End With
      Set xMailObj = Nothing
      Kill xTempFilePath & xFileName & xFileExt
    End If
  Next
  Set xOlApp = Nothing
  With Application
      .ScreenUpdating = True
      .EnableEvents = True
  End With
End Sub

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

4. وأخيرًا، انقر على زر إرسال لإرسال كل بريد إلكتروني واحدًا تلو الآخر.

Kutools لـ Excel: أرسل رسائل بريد إلكتروني مخصصة بسهولة بنقرة واحدة!

هل تعبت من إرسال رسائل البريد الإلكتروني للعملاء واحدة تلو الأخرى؟ مع ميزة 'إرسال البريد الإلكتروني' في Kutools لـ Excel، يصبح التواصل أسرع وأكثر احترافية! فقط قم بإعداد ورقة عمل Excel تحتوي على الأسماء، عناوين البريد الإلكتروني، أكواد التسجيل، وإدراج العناصر النائبة — سيقوم النظام تلقائيًا بتوليد رسائل بريد إلكتروني مخصصة وإرسال المئات منها بنقرة واحدة. لا مزيد من العمل المتكرر!

• 💡 العناصر النائبة الديناميكية (مثل الاسم، رمز التسجيل) تقوم تلقائيًا بتعبئة المحتوى المخصص لكل مستلم، مما يضمن أن كل رسالة بريد تبدو فريدة ومصممة خصيصًا.
• 📎 إرفاق ملفات مخصصة لتوصيل دقيقة
• 📤 يتكامل بسلاسة مع Outlook لإرسال آمن وموثوق
• 📝 احفظ وأعد استخدام قوالب البريد الإلكتروني لتحقيق أقصى كفاءة
• 🎨 محرر سهل الاستخدام مما تراه هو ما تحصل عليه
• 🖋 يستخدم توقيع Outlook الخاص بك — لا حاجة لإعداد إضافي، فقط اضغط على إرسال!
• احصل على Kutools لـ Excel الآن!