• 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.

    [Hình: 5tSdBrVh.png]


    [Hình: Gap3o4th.png]


    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


    [Hình: Gui-mail-bang-thu-vien-CDO.gif]
  • 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 ạ

    [Hình: file]
    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.

    [Hình: 5tSdBrVh.png]


    [Hình: Gap3o4th.png]


    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


    [Hình: Gui-mail-bang-thu-vien-CDO.gif]
  • 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 ạ

    [Hình: file]
    https://www.mediafire.com/view/v6em26cqi...d.png/file

    Bạn đã cấu hình SMTP của bạn ok chưa?