• Tùy chọn
• Đăng nhập
• Đăng ký
• Xem như trên Máy tính
• Accelerated Mobile Pages Theme

Gửi Email bằng thư viện CDO (Collaboration Data Objects)

• Trang chủ

  • Thủ Thuật Access
  • Access Nâng Cao
  • Thư Viện Ứng Dụng
  • [Chương trình] Gửi Email bằng thư viện CDO (Collaboration Data Objects)
• Gửi Email bằng thư viện CDO (Collaboration Data Objects)

• 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

  (26-01-22, 11:31 PM)tuanvr Đã viết: 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?

  
  Mình nghĩ ghi nhớ hay gợi ý thì chắc là phải lưu vào 1 table thì lúc sau gõ sẽ load ra email tương ứng

• 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?
• Bài trước Bài tiếp