VBA Code cho gửi email hàng loạt

[linhnguyenhp1981]

Chào cả nhà,
Mình không biết gì về VBA nên mày mò cóp nhặt các đoạn Code của các bạn trong diễn đàn này rùi tạo thành Module cho việc gửi email mass. Tuy nhiên khi thực hiện lệnh gửi email thì nó báo lỗi. Mình gừi file đính kèm lên đây, nhờ mọi người vui lòng sửa giúp mình với ạ.
Mình cảm ơn nhiều.

 

[anhduong9x9]

Cái này thì dễ thôi. T định làm video hướng dẫn cho mọi người mà sợ mọi người lấy đi khủng bố mail thì chết.

 

[linhnguyenhp1981]

Cái này thì dễ thôi. T định làm video hướng dẫn cho mọi người mà sợ mọi người lấy đi khủng bố mail thì chết.
[/QUOTE
Bạn xem và sửa giúp mình cái code trong file của mình đc không? Cảm ơn bạn nhiều.
P.S Bạn làm video đó đi, mình nghĩ nhiều người sẽ welcome lắm, nhất là nhưng người gà mờ như mình

 

[anhduong9x9]

Thôi nếu bạn cần gấp thì mình làm code luôn cho. Chủ nhật Tuần này, mình sẽ làm video hướng dẫn cho mọi người sau trên kênh youtube "Lucas_D VBA" cho mọi người biết chi tiết sau vậy. Mình chỉ mong mọi người khi biết rồi thì không lấy đấy để khủng bố mail người khác
Đợi mình 15 phút mình cho bạn code.

 

[anhduong9x9]

'*****Youtube Chanel Mr_LucasD VBA: Huong dan lap trinh VBA trong cac ung dung hoc tap, nghien cuu va lam viec hang ngay*****
Sub SendYourMail()
Dim LCDmyMail As CDO.Message
Dim ContentEmail As String
Dim DPPath As String
Dim i, t As Long
Dim ClientMail As Variant
t = ThisWorkbook.Worksheets("SEND EMAIL").Columns("B").Find(What:="*", searchdirection:=xlPrevious, searchorder:=xlByRows, LookIn:=xlValues).Row
ContentEmail = "Gui phieu thu" 'Noi dung cua Mail
For i = 4 To t
ClientMail = ThisWorkbook.Worksheets("SEND EMAIL").Range("B" & i).Value
DPPath = ThisWorkbook.Worksheets("SEND EMAIL").Range("C" & i).Value
Set LCDmyMail = New CDO.Message
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "CunYeu@gmail.com"
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "SugarBrother"
LCDmyMail.Configuration.Fields.Update
With LCDmyMail
.Subject = "Gui phieu thu"
.From = "CunYeu@gmail.com"
.To = ClientMail
.TextBody = ContentEmail
.AddAttachment DPPath
End With
On Error Resume Next
LCDmyMail.Send
Set LCDmyMail = Nothing
Next i
End Sub

Bài đã được tự động gộp: 27/8/20

Để gửi đượcc mail bạn cần là thêm 3 bước sau
B1: Trong dòng lệnh bên trên là mình không biết Mail của bạn là gì và mật khẩu của bạn là gì nên mình giả định mai là "CunYeu@gmail.com" và Mật khẩu giả định là "SugarBrother"
. Bạn cần tìm 2 cái đấy và thay tên mail của bạn và mật khẩu của bạn vào.
B2: Tắt mật khẩu 2 lớp đi thì nó mới auto gửi mail nhé. Gửi mail xong thì hảy bật lại tính năng này trong mail của bạn (Cái này mình ko chắc bạn cứ thử để xem nếu ko gửi được thì tắt đi).
B3: Bật cái tínnh năng cho phép truy cập kém an toàn của mail bạn lên mỗi khi bạn auto gửi mail thì nó mới cho điều khiển được từ VBA. Gửi mail xong vào mail mà thì tắt nó đi

Bài đã được tự động gộp: 27/8/20

 

[anhduong9x9]

À quên nếu bạn copy code sang file khác thì cần làm thêm bước này. Ở file đính kèm tôi đã làm cho bạn rồi. Chúc bạn mãn nguyện với code này.

 

[hackVBA]

À quên nếu bạn copy code sang file khác thì cần làm thêm bước này. Ở file đính kèm tôi đã làm cho bạn rồi. Chúc bạn mãn nguyện với code này.
View attachment 244286

Không cần tắt gửi được không bạn

 

[anhduong9x9]

Không cần tắt gửi được không bạn

Mình không chắc lắm. Vì mình chưa test. chỉ mới tạo bừa 1 mail để giả định gửi thấy nó ok ko vấn đề gì.
Có khi không cần tắt mật khẩu 2 lớp đâu vì bạn đã đăng nhập trên máy rồi, thì cần gì nhờ. Nói chung mình chưa test đâu.
Nhưng cái bật cho phép truy cập kém an toàn là phải có nhé. không bật đố VBA điều khiển gửi được

 

[hackVBA]

Mình không chắc lắm. Vì mình chưa test. chỉ mới tạo bừa 1 mail để giả định gửi thấy nó ok ko vấn đề gì.
Có khi không cần tắt mật khẩu 2 lớp đâu vì bạn đã đăng nhập trên máy rồi, thì cần gì nhờ. Nói chung mình chưa test đâu.
Nhưng cái bật cho phép truy cập kém an toàn là phải có nhé. không bật đố VBA điều khiển gửi được

Mình ko cần tắt vẫn gửi dc

 

[anhduong9x9]

Mình ko cần tắt vẫn gửi dc

Ok. Tại mình chưa test à. Vậy kết luận là cái B2: Không cần tắt mật khẩu 2 lớp đi nhé mọi người. Chúc mọi người vui vẻ với code này. Nếu rảnh qua kênh của mình mình sẽ free dạy cho các bạn. Hoặc hỏi trên này cũng được. mình trả lời tất khi mình rảnh trong thời gian dịch này.

 

[linhnguyenhp1981]

À quên nếu bạn copy code sang file khác thì cần làm thêm bước này. Ở file đính kèm tôi đã làm cho bạn rồi. Chúc bạn mãn nguyện với code này.
View attachment 244286

Bài đã được tự động gộp: 28/8/20

Cảm ơn bạn nhiều.
Chúc bạn một ngày vui.

 

[nguyenphanna]

'*****Youtube Chanel Mr_LucasD VBA: Huong dan lap trinh VBA trong cac ung dung hoc tap, nghien cuu va lam viec hang ngay*****
Sub SendYourMail()
Dim LCDmyMail As CDO.Message
Dim ContentEmail As String
Dim DPPath As String
Dim i, t As Long
Dim ClientMail As Variant
t = ThisWorkbook.Worksheets("SEND EMAIL").Columns("B").Find(What:="*", searchdirection:=xlPrevious, searchorder:=xlByRows, LookIn:=xlValues).Row
ContentEmail = "Gui phieu thu" 'Noi dung cua Mail
For i = 4 To t
ClientMail = ThisWorkbook.Worksheets("SEND EMAIL").Range("B" & i).Value
DPPath = ThisWorkbook.Worksheets("SEND EMAIL").Range("C" & i).Value
Set LCDmyMail = New CDO.Message
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "CunYeu@gmail.com"
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "SugarBrother"
LCDmyMail.Configuration.Fields.Update
With LCDmyMail
.Subject = "Gui phieu thu"
.From = "CunYeu@gmail.com"
.To = ClientMail
.TextBody = ContentEmail
.AddAttachment DPPath
End With
On Error Resume Next
LCDmyMail.Send
Set LCDmyMail = Nothing
Next i
End Sub

Bài đã được tự động gộp: 27/8/20

Để gửi đượcc mail bạn cần là thêm 3 bước sau
B1: Trong dòng lệnh bên trên là mình không biết Mail của bạn là gì và mật khẩu của bạn là gì nên mình giả định mai là "CunYeu@gmail.com" và Mật khẩu giả định là "SugarBrother"
. Bạn cần tìm 2 cái đấy và thay tên mail của bạn và mật khẩu của bạn vào.
B2: Tắt mật khẩu 2 lớp đi thì nó mới auto gửi mail nhé. Gửi mail xong thì hảy bật lại tính năng này trong mail của bạn (Cái này mình ko chắc bạn cứ thử để xem nếu ko gửi được thì tắt đi).
B3: Bật cái tínnh năng cho phép truy cập kém an toàn của mail bạn lên mỗi khi bạn auto gửi mail thì nó mới cho điều khiển được từ VBA. Gửi mail xong vào mail mà thì tắt nó đi

Bài đã được tự động gộp: 27/8/20

'*****Youtube Chanel Mr_LucasD VBA: Huong dan lap trinh VBA trong cac ung dung hoc tap, nghien cuu va lam viec hang ngay*****
Sub SendYourMail()
Dim LCDmyMail As CDO.Message
Dim ContentEmail As String
Dim DPPath As String
Dim i, t As Long
Dim ClientMail As Variant
t = ThisWorkbook.Worksheets("SEND EMAIL").Columns("B").Find(What:="*", searchdirection:=xlPrevious, searchorder:=xlByRows, LookIn:=xlValues).Row
ContentEmail = "Gui phieu thu" 'Noi dung cua Mail
For i = 4 To t
ClientMail = ThisWorkbook.Worksheets("SEND EMAIL").Range("B" & i).Value
DPPath = ThisWorkbook.Worksheets("SEND EMAIL").Range("C" & i).Value
Set LCDmyMail = New CDO.Message
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "CunYeu@gmail.com"
LCDmyMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "SugarBrother"
LCDmyMail.Configuration.Fields.Update
With LCDmyMail
.Subject = "Gui phieu thu"
.From = "CunYeu@gmail.com"
.To = ClientMail
.TextBody = ContentEmail
.AddAttachment DPPath
End With
On Error Resume Next
LCDmyMail.Send
Set LCDmyMail = Nothing
Next i
End Sub

Bài đã được tự động gộp: 27/8/20

Để gửi đượcc mail bạn cần là thêm 3 bước sau
B1: Trong dòng lệnh bên trên là mình không biết Mail của bạn là gì và mật khẩu của bạn là gì nên mình giả định mai là "CunYeu@gmail.com" và Mật khẩu giả định là "SugarBrother"
. Bạn cần tìm 2 cái đấy và thay tên mail của bạn và mật khẩu của bạn vào.
B2: Tắt mật khẩu 2 lớp đi thì nó mới auto gửi mail nhé. Gửi mail xong thì hảy bật lại tính năng này trong mail của bạn (Cái này mình ko chắc bạn cứ thử để xem nếu ko gửi được thì tắt đi).
B3: Bật cái tínnh năng cho phép truy cập kém an toàn của mail bạn lên mỗi khi bạn auto gửi mail thì nó mới cho điều khiển được từ VBA. Gửi mail xong vào mail mà thì tắt nó đi

Bài đã được tự động gộp: 27/8/20

View attachment 244285

chào bạn, rất cảm ơn bạn vì đã giúp đỡ mọi người ạ.

Mình đã tìm để theo dõi video hướng dẫn của bạn mà không thấy.
Mong bạn giúp đỡ thêm là: nếu mình muốn gửi từ 2 file khác nhau trở lên thì mình cần chỉnh thêm gì trong module trên ạ
Cảm ơn bạn rất nhiều