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
- S1 là ô chứa địa chỉ email mà bạn muốn gửi email đến. Vui lòng thay đổi chúng theo nhu cầu của bạn.
- Bạn có thể chỉ định CC, BCC, Subject, Body cho riêng mình trong mã;
- Để gửi email trực tiếp mà không cần mở cửa sổ thư mới sau đây, bạn cần thay đổi .Trưng bày đến .Gửi.
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.
Công cụ năng suất văn phòng tốt nhất
Nâng cao kỹ năng Excel của bạn với Kutools for Excel và trải nghiệm hiệu quả hơn bao giờ hết. Kutools for Excel cung cấp hơn 300 tính năng nâng cao để tăng năng suất và tiết kiệm thời gian. Bấm vào đây để có được tính năng bạn cần nhất...
Tab Office mang lại giao diện Tab cho Office và giúp công việc của bạn trở nên dễ dàng hơn nhiều
- Cho phép chỉnh sửa và đọc theo thẻ trong Word, Excel, PowerPoint, Publisher, Access, Visio và Project.
- Mở và tạo nhiều tài liệu trong các tab mới của cùng một cửa sổ, thay vì trong các cửa sổ mới.
- Tăng 50% năng suất của bạn và giảm hàng trăm cú nhấp chuột cho bạn mỗi ngày!
