Làm cách nào để gửi từng trang tính đến các địa chỉ email khác nhau từ Excel?

Nếu bạn có một sổ làm việc với nhiều trang tính và có một địa chỉ email trong ô A1 của mỗi trang tính. Bây giờ, bạn muốn gửi từng trang tính từ sổ làm việc dưới dạng tệp đính kèm đến người nhận tương ứng trong ô A1 riêng lẻ. Làm thế nào bạn có thể giải quyết công việc này trong Excel? Bài viết này, tôi sẽ giới thiệu một mã VBA để gửi từng trang tính dưới dạng tệp đính kèm đến địa chỉ email khác nhau từ Excel.

---

Gửi từng trang tính đến các địa chỉ email khác nhau từ Excel với mã VBA

Mã VBA sau có thể giúp bạn gửi từng trang tính dưới dạng tệp đính kèm đến những người nhận khác nhau, vui lòng thực hiện như sau:

1. nhấn Alt + F11 các phím đồng thời để mở Microsoft Visual Basic cho các ứng dụng cửa sổ.

2. Sau đó nhấn vào Chèn > Mô-đunvà sao chép và dán mã VBA bên dưới vào cửa sổ.

Mã VBA: Gửi từng trang tính dưới dạng tệp đính kèm đến các địa chỉ email khác nhau

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. Sau đó nhấn F5 để chạy mã này và mỗi trang tính được tự động chèn vào cửa sổ thư mới dưới dạng tệp đính kèm, xem ảnh chụp màn hình:

4. Cuối cùng, bạn chỉ cần nhấn Gửi để gửi từng email một.