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

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

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

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

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

2. ثم اضغط إدراج > وحدة، وانسخ والصق رمز فبا أدناه في النافذة.

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

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. أخيرًا ، ما عليك سوى النقر فوق أرسل زر لإرسال كل بريد إلكتروني واحدًا تلو الآخر.