Gửi email tính lương cho từng người bằng Outlook
Gửi các bạn file và đoạn code để gửi email bảng lương (có đính kèm file) qua Outlook bằng Excel, rất tiện lợi cho những ai làm việc trong lĩnh vực nhân sự cũng như những ai muốn học hỏi về cách gửi mail hàng loạt từ Excel thông qua Outlook.
Ngoài ra, bạn có thể tham khảo thêm bài viết này nếu bạn dùng Lotus Note thay vì Outlook.
Mã:
Option Explicit
Sub GuiMail()
Dim OutApp As Object, OutMail As Object
Dim WB As Workbook, Ash As Worksheet, mailAddress As String, i As Integer, ir As Integer
Dim Rcount As Long, FileName As String, Rnum As Long, strHeader As String, strRow As String
On Error GoTo cleanup
Set OutApp = CreateObject("Outlook.Application")
Set Ash = Sheet1
Rcount = Application.WorksheetFunction.CountA(Ash.Columns(1))
For i = 1 To 18
strHeader = strHeader & " " & "<th>" & Ash.Cells(1, i) & "</th>"
Next
If Rcount >= 2 Then
For Rnum = 2 To Rcount
strRow = ""
For ir = 1 To 18
strRow = strRow & " " & "<td>" & Ash.Cells(Rnum, ir) & "</td>"
Sheets("Form").Cells(2, ir) = Ash.Cells(Rnum, ir)
Next
mailAddress = ""
On Error Resume Next
mailAddress = Application.WorksheetFunction. _
VLookup(Ash.Cells(Rnum, 1).Value, _
Worksheets("Mailinfo").Range("A1:C" & _
Worksheets("Mailinfo").Rows.Count), 3, False)
Sheets("Form").Copy
Set WB = ActiveWorkbook
FileName = Ash.Cells(Rnum, 1) & ".xls"
Kill "C:\" & FileName
On Error GoTo 0
WB.SaveAs FileName:="C:\" & FileName
If mailAddress <> "" Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = mailAddress
.Subject = "Chi tiet bang luong: " & Ash.Range("B" & Rnum) _
& " (Voi he so chuc danh la " & Ash.Range("C" & Rnum) & ")"
.Attachments.Add WB.FullName
.HTMLBody = "<B>Dear " & Ash.Range("B" & Rnum) & ",</B><BR>" & _
"Xin vui long xem chi tiet bang luong nhu ben duoi:<BR><BR>" & _
"<table border=1><tr>" & _
strHeader & _
"</tr><tr>" & _
strRow & _
"</tr>" & _
"</table>" & _
"<BR>" & _
"Neu thay co gi thac mac xin vui long phan hoi som.<BR>" & _
"<B>Xin Cam on,</B>" & _
"<BR>" & _
"<B>HLMT<B>"
.Display 'Or use Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
WB.ChangeFileAccess Mode:=xlReadOnly
Kill WB.FullName
WB.Close SaveChanges:=False
Next Rnum
End If
MsgBox "Da tao xong email gui", vbInformation
'ThisWorkbook.Close (False)
cleanup:
Set OutApp = Nothing: Set OutMail = Nothing
End SubMột số câu hỏi khác, bạn có thể vào topic sau để bàn luận thêm: http://www.giaiphapexcel.com/forum/showthread.php?48211
Một số bài viết có liên quan:
1/ Dùng Excel để gửi mail trong Lotus Note
2/ Conditional Formatting cho biểu đồ bằng VBA
3/ Khi nào nên sử dụng Msgbox, Inputbox và Userform?
4/ 8 thủ thuật trong VBE bạn nên biết
5/ Kích hoạt macro từ nút bấm ngoài bảng tính
6/ Làm thế nào để thay thế các chữ OK, CANCEL,... nhàm chán của Msgbox
7/ Giới thiệu VBA trong Excel
8/ Viết code để nhìn thấy ai là người cập nhật bảng tính của bạn lần gần đây nhất
9/ 4 cách sử dụng Immediate Window trong VBA hiệu quả hơn
10/ 3 gợi ý nhỏ mang lại thành công trong khai báo biến trong VBA
Chỉnh sửa lần cuối bởi điều hành viên:
