จะส่งแต่ละแผ่นไปยังที่อยู่อีเมลที่ต่างกันจาก Excel ได้อย่างไร
หากคุณมีเวิร์กบุ๊กที่มีหลายเวิร์กชีต และมีที่อยู่อีเมลอยู่ในเซลล์ A1 ของแต่ละชีต ตอนนี้ คุณต้องการส่งแผ่นงานแต่ละแผ่นจากสมุดงานเป็นสิ่งที่แนบมากับผู้รับที่เกี่ยวข้องในเซลล์ A1 ทีละรายการ คุณจะแก้ปัญหานี้ใน Excel ได้อย่างไร บทความนี้ผมจะแนะนำรหัส VBA เพื่อส่งแต่ละแผ่นเป็นไฟล์แนบไปยังที่อยู่อีเมลอื่นจาก Excel
ส่งแต่ละแผ่นไปยังที่อยู่อีเมลอื่นจาก Excel ด้วยรหัส VBA
รหัส VBA ต่อไปนี้สามารถช่วยคุณส่งแผ่นงานแต่ละแผ่นเป็นไฟล์แนบไปยังผู้รับที่แตกต่างกัน โปรดดำเนินการดังนี้:
1. กด Alt + F11 พร้อมกันเพื่อเปิดไฟล์ Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง
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
- S1 คือเซลล์ที่มีที่อยู่อีเมลที่คุณต้องการส่งอีเมลไป กรุณาเปลี่ยนตามความต้องการของคุณ
- คุณสามารถระบุ CC, BCC, Subject, Body เป็นของคุณเองในรหัส
- ในการส่งอีเมลโดยตรงโดยไม่ต้องเปิดหน้าต่างข้อความใหม่ต่อไปนี้ คุณต้องเปลี่ยน .แสดง ไปยัง .ส่ง.
3. จากนั้นกด F5 เพื่อเรียกใช้รหัสนี้และแต่ละแผ่นจะถูกแทรกลงในหน้าต่างข้อความใหม่เป็นไฟล์แนบโดยอัตโนมัติ ดูภาพหน้าจอ:
4. สุดท้าย คุณเพียงแค่ต้องคลิก ส่ง ปุ่มเพื่อส่งอีเมลทีละฉบับ
สุดยอดเครื่องมือเพิ่มผลผลิตในสำนักงาน
เพิ่มพูนทักษะ Excel ของคุณด้วย Kutools สำหรับ Excel และสัมผัสประสิทธิภาพอย่างที่ไม่เคยมีมาก่อน Kutools สำหรับ Excel เสนอคุณสมบัติขั้นสูงมากกว่า 300 รายการเพื่อเพิ่มประสิทธิภาพและประหยัดเวลา คลิกที่นี่เพื่อรับคุณสมบัติที่คุณต้องการมากที่สุด...
แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก
- เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
- เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
- เพิ่มประสิทธิภาพการทำงานของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!