Sử dụng macro trong excel để gửi email

Xin chào,

Tôi có một macro được thiết lập trong excel mà tôi sử dụng để gửi email đến những người nhận khác nhau. Hiện tại, nó chỉ hoạt động nếu có tệp đính kèm nhưng không phải lúc nào tôi cũng cần gửi tệp đính kèm. Có ai biết tôi cần xóa phần nào của mã để gửi email mà không có tệp đính kèm không?

(Kiến thức về macro của tôi rất hạn chế!)

Phụ Send_Files()

'Cột A-name, B-To email, C-cc email, D-Subject, E-HTM body, F:Z-attachments

Dim OutApp làm đối tượng

Dim OutMail làm đối tượng

Dim sh As Worksheet

Dim cell As Range, FileCell As Range, rng As Range

Với ứng dụng

.EnableEvents = Sai

.ScreenUpdating = Sai

Kết thúc với

Đặt sh = Sheets("Mailmerge")

Đặt OutApp = CreateObject("Outlook.Application")

Đối với mỗi ô Trong sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

Đặt rng = sh.Cells(cell.Row, 1).Range("F1:H1")

Nếu ô. Giá trị Giống như "?*@?*.?*" Và _

Application.WorksheetFunction.CountA(rng) > 0 Sau đó

Đặt OutMail = OutApp.CreateItem(0)

strbody = GetBoiler(cell.Offset(0, 3))

strbody = Replace(strbody, "insert_name_here", cell.Offset(0, -1).Value, So sánh:=vbTextCompare)

strbody = Replace(strbody, "hospital_code", cell.Offset(0, 7).Value, So sánh:=vbTextCompare)

strbody = Replace(strbody, "hospital_name", cell.Offset(0, 8).Value, Compare:=vbTextCompare)

strbody = Replace(strbody, "data_query", cell.Offset(0, 9).Value, So sánh:=vbTextCompare)

strbody = Replace(strbody, "event_date", cell.Offset(0, 10).Value, So sánh:=vbTextCompare)

Với OutMail

.To = ô.Giá trị

.Subject = ô.Offset(0, 2)

.cc = ô.Offset(0, 1)

.HTMLBody = strbody

Đối với mỗi FileCell Trong rng.SpecialCells(xlCellTypeConstants)

Nếu Trim(FileCell) <> "" Thì

Nếu Dir(FileCell.Value) <> "" Thì

.Attachments.Add FileCell.Value

kết thúc nếu

kết thúc nếu

Tệp tiếp theoCell

.Send 'Hoặc sử dụng Hiển thị

Kết thúc với

Đặt OutMail = Không có gì

kết thúc nếu

ô tiếp theo

Set OutApp = Không có gì

Với ứng dụng

.EnableEvents = Đúng

.ScreenUpdating = True

Kết thúc với

kết thúc phụ

Hàm GetBoiler(ByVal sFile dưới dạng chuỗi) dưới dạng chuỗi

Dim fso làm đối tượng

Dim ts làm đối tượng

Đặt fso = CreateObject("Scripting.FileSystemObject")

Đặt ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)

GetBoiler = ts.readall

ts.Đóng

chức năng kết thúc

>

Thanks!

Câu trả lời:

Xóa các dòng

Đối với mỗi FileCell Trong rng.SpecialCells(xlCellTypeConstants)
Nếu Trim(FileCell) <> "" Thì
Nếu Dir(FileCell.Value) <> "" Thì
.Attachments.Add FileCell.Value
kết thúc nếu
kết thúc nếu
Tệp tiếp theoCell