-
Gửi Email bằng thư viện CDO (Collaboration Data Objects)
ongke0711 > 23-01-22, 01:15 PM
Việc gửi email trong Ms Access theo tôi biết là có 3 cách:
1. Dùng Docmd.SendObject mặc định có trong Access
2. Dùng luôn thư việc ứng dụng của Ms Outlook để gửi.
3. Dùng thư viện Collaboration Data Objects (CDO) của Windows.
Mỗi cách đều có các điểm mạnh/ yếu nên tuỳ theo tình huống thực tế viết ứng dụng mà chọn code theo cách nào thôi.
- Nếu dùng phương thức SendObject của Ms Access, thì nó chỉ cho đính kèm 1 file và file này phải là Access database. Bên cạnh đó nó cũng tuỳ thuộc vào ứng dụng mail đang cài trên máy.
- Dùng thư viện của Ms Outlook thì rất mạnh, hỗ trợ nhiều tác vụ, nhiều chức năng, 2 phương pháp còn lại không so được. Nhưng nó cũng phải phụ thuộc vào máy khách có cài, có sử dụng Ms Outlook hay không? Và tính bảo mật cao của Ms Outlook cũng có khi gây trở ngại khi cấu hình gửi mail, file đính kèm.
- Cách thứ 3 dùng CDO (thư viện "Microsoft CDO for Windows 2000"). Thư việc này mặc định đã được Windows cài sẵn trên máy tính, không cần phụ thuộc vào máy tính có cài ứng dụng gửi email hay không. Hiện tại tôi dùng Windows 10 thì vẫn còn thư viện này để chạy, không biết các phiên bản sau này có còn hay không. CDO có thể hỗ trợ gửi email với nhiều file đính kèm, với nhiều định dạng file khác nhau. Một điểm trở ngại khi dùng CDO mà tôi thấy đó là tốc độ đính kèm file và gửi đi khá chậm so với việc dùng thư viện của ứng dụng Ms Outlook. Nhưng với những điểm thuận lợi bên trên thì tôi nghĩ CDO vẫn rất đáng để dùng trong việc gửi mail từ Access và đặc biệt khi bạn xây dựng ứng dụng Access đa người dùng (không cần phải cài Ms Outlook cho từng máy client khi phân phối ứng dụng).
Dưới đây là file demo tôi dùng CDO để gửi email + đính kèm file theo cách cơ bản nhất.
Các bạn có thể dùng cách khai báo CDO trong code để mở rộng, viết riêng cho ứng dụng của mình như: tạo nút gửi email hàng loạt (có đính kèm file) cho nhân viên (như bảng lương, thông báo,...)
Khai báo CDO trong file này tôi dùng cho dịch vụ gửi mail của Google do nó khá phổ biến. Nếu các bạn dùng nhà cung cấp dịch vụ gửi mail khác như: Hotmail, office 365 thì có thể search trên mạng cách thức cấu hình để gửi mail tương ứng của nhà cung cấp mail đó.
Vd:
Thiết lập CDO cho mail Office 365,
* Lưu ý:
Nếu dùng Gmail để gửi email đi thì Gmail phải không được dùng tính năng "Bảo mật 2 lớp" và trong Setting của Gmail phải chọn "ON" cho "Less Secure Apps" thì mới có thể gửi mail thông qua giao thức SMTP.
Code:
Mã PHP:Private Sub cmdSend_Click()
On Error GoTo errHandler
Dim cdoConfig As Object
Dim cdoMessage As Object
'Kiem tra thong tin gui
If Me.txtTo & "" = "" Then
Me.txtTo.SetFocus
MsgBoxUni "Vui l" & ChrW(242) & "ng nh" & ChrW(7853) & "p " & ChrW(273) & ChrW(7883) & "a ch" & ChrW(7881) & " Email c" & ChrW(7911) & "a ng" & ChrW(432) & ChrW(7901) & "i nh" & ChrW(7853) & "n.", vbInformation, "Th" & ChrW(244) & "ng tin b" & ChrW(7855) & "t bu" & ChrW(7897) & "c"
ElseIf Me.txtSubj & "" = "" Then
Me.txtSubj.SetFocus
MsgBoxUni "Vui l" & ChrW(242) & "ng nh" & ChrW(7853) & "p d" & ChrW(242) & "ng Ti" & ChrW(234) & "u " & ChrW(273) & ChrW(7873) & ".", vbInformation, "Th" & ChrW(244) & "ng tin b" & ChrW(7855) & "t bu" & ChrW(7897) & "c"
ElseIf Me.txtMsg & "" = "" Then
Me.txtMsg.SetFocus
MsgBoxUni "Vui l" & ChrW(242) & "ng nh" & ChrW(7853) & "p n" & ChrW(7897) & "i dung th" & ChrW(432) & ".", vbInformation, "Th" & ChrW(244) & "ng tin b" & ChrW(7855) & "t bu" & ChrW(7897) & "c"
Else
Dim rs As DAO.Recordset
Set rs = DBEngine(0)(0).OpenRecordset("tblEmailCDOSettings", dbOpenSnapshot)
If rs.EOF And rs.BOF Then
MsgBoxUni "Kh" & ChrW(244) & "ng c" & ChrW(243) & " th" & ChrW(244) & "ng tin c" & ChrW(7845) & "u h" & ChrW(236) & "nh cho h" & ChrW(7879) & " th" & ChrW(7889) & "ng Email." & vbCrLf & vbCrLf _
& "Vui l" & ChrW(242) & "ng ki" & ChrW(7875) & "m tra v" & ChrW(224) & " thi" & ChrW(7871) & "t l" & ChrW(7853) & "p l" & ChrW(7841) & "i c" & ChrW(7845) & "u h" & ChrW(236) & "nh.", vbExclamation, "Thông báo"
Exit Sub
End If
Set cdoConfig = CreateObject("CDO.Configuration")
Set cdoMessage = CreateObject("CDO.Message")
'Nap tham sô cau hình CDO
With cdoConfig.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = rs!SMTPServer
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = rs!PortNumber
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = rs!Authentication
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = rs!SendUsing
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = rs!SSL
.Item("http://schemas.microsoft.com/cdo/configuration/sendtls") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = rs!Timeout
If rs!Authentication > 0 Then
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = rs!Username
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = rs!Password
End If
.Update
End With
DoCmd.Hourglass True
'Gui email
With cdoMessage
Set .Configuration = cdoConfig
.From = rs!Username
.To = Me.txtTo
.Cc = Nz(Me.txtCc, "")
'.Bcc = "blind.copy@email.address"
.Subject = Me.txtSubj
.BodyPart.Charset = "UTF-8"
'.TextBody = Me.txtMsg
.HTMLBody = Me.txtMsg
'/Dinh kem nhieu file
Dim rsAttach As DAO.Recordset
Set rsAttach = DBEngine(0)(0).OpenRecordset("tblAttachFiles")
If rsAttach.EOF And rsAttach.BOF Then
.Attachments.DeleteAll
Else
Do Until rsAttach.EOF
.AddAttachment rsAttach!AttachedFilePath
If Err.Number <> 0 Then
.HTMLBody = .HTMLBody & vbCrLf & vbCrLf & _
"Không dính kèm duoc file: " & rsAttach!AttachedFilePath
Err.Clear
End If
rsAttach.MoveNext
Loop
End If
'/---------------------
.Send
End With
DoCmd.Hourglass False
MsgBoxUni ChrW(272) & ChrW(227) & " g" & ChrW(7917) & "i Email th" & ChrW(224) & "nh c" & ChrW(244) & "ng.", vbInformation, "Thành công"
rs.Close
rsAttach.Close
Set rs = Nothing
Set rsAttach = Nothing
DoCmd.Close
End If
errExit:
On Error Resume Next
Set cdoConfig = Nothing
Set cdoMessage = Nothing
Exit Sub
errHandler:
MsgBox Err.Number & ": " & Err.Description
Resume errExit
End Sub
Link file demo: https://www.mediafire.com/file/vd8j13cou...accdb/file
-
RE: Gửi Email bằng thư viện CDO (Collaboration Data Objects)
AnNguyen > 24-01-22, 09:10 AM
Hay quá. Cảm ơn anh nhiều. Đúng đoạn em đang cần gửi email mà không cần cài outloock -
RE: Gửi Email bằng thư viện CDO (Collaboration Data Objects)
tuanvr > 26-01-22, 11:31 PM
Hay, mò mãi cũng tìm thấy đúng bài của anh, có điều có ghi nhớ/gợi ý các email đã gửi không anh? -
RE: Gửi Email bằng thư viện CDO (Collaboration Data Objects)
AnNguyen > 27-01-22, 09:43 AM
-
RE: Gửi Email bằng thư viện CDO (Collaboration Data Objects)
quanghoack > 10-04-23, 02:18 AM
sao em gửi nó báo lỗi như thế này là sao ạ
https://www.mediafire.com/view/v6em26cqi...d.png/file
(23-01-22, 01:15 PM)ongke0711 Đã viết: Việc gửi email trong Ms Access theo tôi biết là có 3 cách:
1. Dùng Docmd.SendObject mặc định có trong Access
2. Dùng luôn thư việc ứng dụng của Ms Outlook để gửi.
3. Dùng thư viện Collaboration Data Objects (CDO) của Windows.
Mỗi cách đều có các điểm mạnh/ yếu nên tuỳ theo tình huống thực tế viết ứng dụng mà chọn code theo cách nào thôi.
- Nếu dùng phương thức SendObject của Ms Access, thì nó chỉ cho đính kèm 1 file và file này phải là Access database. Bên cạnh đó nó cũng tuỳ thuộc vào ứng dụng mail đang cài trên máy.
- Dùng thư viện của Ms Outlook thì rất mạnh, hỗ trợ nhiều tác vụ, nhiều chức năng, 2 phương pháp còn lại không so được. Nhưng nó cũng phải phụ thuộc vào máy khách có cài, có sử dụng Ms Outlook hay không? Và tính bảo mật cao của Ms Outlook cũng có khi gây trở ngại khi cấu hình gửi mail, file đính kèm.
- Cách thứ 3 dùng CDO (thư viện "Microsoft CDO for Windows 2000"). Thư việc này mặc định đã được Windows cài sẵn trên máy tính, không cần phụ thuộc vào máy tính có cài ứng dụng gửi email hay không. Hiện tại tôi dùng Windows 10 thì vẫn còn thư viện này để chạy, không biết các phiên bản sau này có còn hay không. CDO có thể hỗ trợ gửi email với nhiều file đính kèm, với nhiều định dạng file khác nhau. Một điểm trở ngại khi dùng CDO mà tôi thấy đó là tốc độ đính kèm file và gửi đi khá chậm so với việc dùng thư viện của ứng dụng Ms Outlook. Nhưng với những điểm thuận lợi bên trên thì tôi nghĩ CDO vẫn rất đáng để dùng trong việc gửi mail từ Access và đặc biệt khi bạn xây dựng ứng dụng Access đa người dùng (không cần phải cài Ms Outlook cho từng máy client khi phân phối ứng dụng).
Dưới đây là file demo tôi dùng CDO để gửi email + đính kèm file theo cách cơ bản nhất.
Các bạn có thể dùng cách khai báo CDO trong code để mở rộng, viết riêng cho ứng dụng của mình như: tạo nút gửi email hàng loạt (có đính kèm file) cho nhân viên (như bảng lương, thông báo,...)
Khai báo CDO trong file này tôi dùng cho dịch vụ gửi mail của Google do nó khá phổ biến. Nếu các bạn dùng nhà cung cấp dịch vụ gửi mail khác như: Hotmail, office 365 thì có thể search trên mạng cách thức cấu hình để gửi mail tương ứng của nhà cung cấp mail đó.
Vd:
Thiết lập CDO cho mail Office 365,
* Lưu ý:
Nếu dùng Gmail để gửi email đi thì Gmail phải không được dùng tính năng "Bảo mật 2 lớp" và trong Setting của Gmail phải chọn "ON" cho "Less Secure Apps" thì mới có thể gửi mail thông qua giao thức SMTP.
Code:
Mã PHP:Private Sub cmdSend_Click()
On Error GoTo errHandler
Dim cdoConfig As Object
Dim cdoMessage As Object
'Kiem tra thong tin gui
If Me.txtTo & "" = "" Then
Me.txtTo.SetFocus
MsgBoxUni "Vui l" & ChrW(242) & "ng nh" & ChrW(7853) & "p " & ChrW(273) & ChrW(7883) & "a ch" & ChrW(7881) & " Email c" & ChrW(7911) & "a ng" & ChrW(432) & ChrW(7901) & "i nh" & ChrW(7853) & "n.", vbInformation, "Th" & ChrW(244) & "ng tin b" & ChrW(7855) & "t bu" & ChrW(7897) & "c"
ElseIf Me.txtSubj & "" = "" Then
Me.txtSubj.SetFocus
MsgBoxUni "Vui l" & ChrW(242) & "ng nh" & ChrW(7853) & "p d" & ChrW(242) & "ng Ti" & ChrW(234) & "u " & ChrW(273) & ChrW(7873) & ".", vbInformation, "Th" & ChrW(244) & "ng tin b" & ChrW(7855) & "t bu" & ChrW(7897) & "c"
ElseIf Me.txtMsg & "" = "" Then
Me.txtMsg.SetFocus
MsgBoxUni "Vui l" & ChrW(242) & "ng nh" & ChrW(7853) & "p n" & ChrW(7897) & "i dung th" & ChrW(432) & ".", vbInformation, "Th" & ChrW(244) & "ng tin b" & ChrW(7855) & "t bu" & ChrW(7897) & "c"
Else
Dim rs As DAO.Recordset
Set rs = DBEngine(0)(0).OpenRecordset("tblEmailCDOSettings", dbOpenSnapshot)
If rs.EOF And rs.BOF Then
MsgBoxUni "Kh" & ChrW(244) & "ng c" & ChrW(243) & " th" & ChrW(244) & "ng tin c" & ChrW(7845) & "u h" & ChrW(236) & "nh cho h" & ChrW(7879) & " th" & ChrW(7889) & "ng Email." & vbCrLf & vbCrLf _
& "Vui l" & ChrW(242) & "ng ki" & ChrW(7875) & "m tra v" & ChrW(224) & " thi" & ChrW(7871) & "t l" & ChrW(7853) & "p l" & ChrW(7841) & "i c" & ChrW(7845) & "u h" & ChrW(236) & "nh.", vbExclamation, "Thông báo"
Exit Sub
End If
Set cdoConfig = CreateObject("CDO.Configuration")
Set cdoMessage = CreateObject("CDO.Message")
'Nap tham sô cau hình CDO
With cdoConfig.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = rs!SMTPServer
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = rs!PortNumber
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = rs!Authentication
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = rs!SendUsing
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = rs!SSL
.Item("http://schemas.microsoft.com/cdo/configuration/sendtls") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = rs!Timeout
If rs!Authentication > 0 Then
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = rs!Username
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = rs!Password
End If
.Update
End With
DoCmd.Hourglass True
'Gui email
With cdoMessage
Set .Configuration = cdoConfig
.From = rs!Username
.To = Me.txtTo
.Cc = Nz(Me.txtCc, "")
'.Bcc = "blind.copy@email.address"
.Subject = Me.txtSubj
.BodyPart.Charset = "UTF-8"
'.TextBody = Me.txtMsg
.HTMLBody = Me.txtMsg
'/Dinh kem nhieu file
Dim rsAttach As DAO.Recordset
Set rsAttach = DBEngine(0)(0).OpenRecordset("tblAttachFiles")
If rsAttach.EOF And rsAttach.BOF Then
.Attachments.DeleteAll
Else
Do Until rsAttach.EOF
.AddAttachment rsAttach!AttachedFilePath
If Err.Number <> 0 Then
.HTMLBody = .HTMLBody & vbCrLf & vbCrLf & _
"Không dính kèm duoc file: " & rsAttach!AttachedFilePath
Err.Clear
End If
rsAttach.MoveNext
Loop
End If
'/---------------------
.Send
End With
DoCmd.Hourglass False
MsgBoxUni ChrW(272) & ChrW(227) & " g" & ChrW(7917) & "i Email th" & ChrW(224) & "nh c" & ChrW(244) & "ng.", vbInformation, "Thành công"
rs.Close
rsAttach.Close
Set rs = Nothing
Set rsAttach = Nothing
DoCmd.Close
End If
errExit:
On Error Resume Next
Set cdoConfig = Nothing
Set cdoMessage = Nothing
Exit Sub
errHandler:
MsgBox Err.Number & ": " & Err.Description
Resume errExit
End Sub
Link file demo: https://www.mediafire.com/file/vd8j13cou...accdb/file
-
RE: Gửi Email bằng thư viện CDO (Collaboration Data Objects)
AnNguyen > 11-04-23, 08:27 AM
(10-04-23, 02:18 AM)quanghoack Đã viết: sao em gửi nó báo lỗi như thế này là sao ạ
https://www.mediafire.com/view/v6em26cqi...d.png/file
Bạn đã cấu hình SMTP của bạn ok chưa?