RaoVat24h
Office Word

Cách gửi mail tự động trên Excel bằng VBA [+File mẫu tải về]

Advertisement

Cách gửi mail tự động trên Excel bằng VBA [+File mẫu tải về]

Mail sẽ gửi tự động vào ngày sinh nhật của ai đó trong danh sách cho trước.
Template Picture-2

Danh sách tên,mail, ngày sinh nhật…

“DataSheet”Data Sheet Picture-1(Picture 1)

Template Picture-2(Picture 2)
Click Module Picture-3(Picture 3)
Code sử dụng cho Gmail
Thêm vào thư viện Microsoft CDO for windows 2000 library
Refrences-VBA Project Box Picture-4(Picture 4)
Code VBA gửi Gmail
Sub sendemail()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim Lr As Integer
Dim bdate As Range
Dim firstName As String
Set ws = Sheets("DataSheet") ' Your data sheet.
Set ws1 = Sheets("MailMerge") ' Your template sheet
Set myMail = New CDO.Message
Lr = ws.Cells(Rows.Count, 1).End(xlUp).Row ' to get the last row no in your datasheet file
For i = 2 To Lr
Application.ScreenUpdating = False
Set bdate = ws.Range("D" & i)
checking = (Format(bdate, "mmm-dd") = Format(Date, "mmm-dd")) ' Birthday checking with today's date
ws.Cells(i, 8).value = checking
If ws.Cells(i, 8).value = True Then
firstName = ws.Cells(i, 2)
msg = "Dear " & firstName & "," & vbCrLf & vbCrLf
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "test@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "yourpassword"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
strbody = "Hello" & fristname & "," & vbNewLine & vbNewLine & _
"Celebrate your birthday today. Celebrate being Happy every day." & vbNewLine & vbNewLine & _
"Hoping you get a big promotion and an even bigger pay raise this year." & vbNewLine & vbNewLine & _
"You deserve it. Besides, it's about time you picked up our lunch tab. " & vbNewLine & vbNewLine & _
vbNewLine & vbNewLine & _
vbNewLine & vbNewLine & _
"Happy Birthday to you!!!" & vbNewLine & vbNewLine & _
vbNewLine & vbNewLine & _
"Niladri Sekhar Biswas"

With iMsg
Dim email As String
email = ws.Range("G" & i).value
Set .Configuration = iConf
.To = email
.CC = ""
.BCC = ""
' Note: The reply address is not working if you use this Gmail example
' It will use your Gmail address automatic. But you can add this line
' to change the reply address .ReplyTo = "Reply@something.nl"
.From = """Test"" <test@gmail.com>"
.Subject = "Important message"
.TextBody = strbody
.AddAttachment "E:happy_birthday_card.jpg"
.Send
MsgBox "Mail send"
End With
End If
Next
Application.ScreenUpdating = True
End Sub
Thêm nút ấn điều khiển
Assign Macro Box Picture-5(Picture 5)
Cài  đặt cho phép trên Gmail
Allow Less Secure Apps Picture-6(Picture 6)

Gửi mail tự động trong Outlook:

Dim Outlook As Object
Dim Email As Object
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim address As Range, rngCell As Range
Dim Recipients As String
Dim Lr As Integer
Dim i As Integer
Dim msg As String
Dim bdate As Range
Set ws = Sheets("DataSheet") ' Your data sheet.
Set ws1 = Sheets("MailMerge")
Lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Lr
Set Outlook = CreateObject("Outlook.Application")
Set Email = Outlook.CreateItem(0)
Set bdate = ws.Range("D" & i)
checking = (Format(bdate, "mmm-dd") = Format(Date, "mmm-dd")) ' Birthday checking with today's date
ws.Cells(i, 8).value = checking
If ws.Cells(i, 8).value = True Then
firstName = ws.Cells(i, 2)
Recipients = ws.Range("G" & i).value

msg = ""
msg = msg & "Dear " & firstName & "," & vbCrLf & vbCrLf

msg = msg & "Celebrate your birthday today. Celebrate being Happy every day. " & vbCrLf & vbCrLf

msg = msg & "Hoping you get a big promotion and an even bigger pay raise this year. Happy Birthday to you!!!" & vbCrLf & vbCrLf

msg = msg & "Thanks" & vbCrLf & vbCrLf

msg = msg & "Kind Regards" & vbCrLf & vbCrLf
msg = msg & "Niladri Sekhar Biswas"
Email.Importance = 2
Email.Subject = "Happy Birthday!!!"
Email.Body = msg
'Email.Attachments.Add ActiveWorkbook.FullName
'Set Recipient
Email.To = Recipients
Email.Send

End If
Next
MsgBox "Email Sent Successfully"
End Sub
Further, let me know if you created a variant for this? Happy to discuss new ideas ? Mail Merge through VBA in Microsoft Excel

?You download App EVBA.info installed directly on the latest phone here : https://www.evba.info/p/app-evbainfo-setting-for-your-phone.html?m=1

?DienDan.Edu.Vn cám ơn bạn đã quan tâm và rất vui vì bài viết đã đem lại thông tin hữu ích cho bạn. https://diendan.edu.vn/

Rate this post

DienDan.Edu.Vn

DienDan.Edu.Vn Cám ơn bạn đã quan tâm và rất vui vì bài viết đã đem lại thông tin hữu ích cho bạn.
DienDan.Edu.Vn! là một website với tiêu chí chia sẻ thông tin,... Bạn có thể nhận xét, bổ sung hay yêu cầu hướng dẫn liên quan đến bài viết. Vậy nên đề nghị các bạn cũng không quảng cáo trong comment này ngoại trừ trong chính phần tên của bạn.
Cám ơn.

Đăng bình luận

(+84) (901) 369.468