Nhờ sửa lỗi gửi email bằng CDO (1 người xem)

[MinhKhai]

Chào các anh chị.

Em có tìm được đoạn code để gửi email bằng VBA thông qua CDO
Khi dùng với 1 maibox khác thì chạy được, trong khi dùng mailbox Exchange của em thì chạy báo lỗi như hình dưới. Em đã Google mã lỗi như dưới mà không xử lý.
Nhờ các anh chị, ai có kinh nghiệm với lỗi trên thì xin giúp đỡ. Em xin gửi riêng thông tin mailbox

 

[HeSanbi]

smtpserver phải được đặt kiểu như "smtp.gmail.com", "mailbox01.contoso.com", ...

 

[hungpecc1]

Chào các anh chị.

Em có tìm được đoạn code để gửi email bằng VBA thông qua CDO
Khi dùng với 1 maibox khác thì chạy được, trong khi dùng mailbox Exchange của em thì chạy báo lỗi như hình dưới. Em đã Google mã lỗi như dưới mà không xử lý.
Nhờ các anh chị, ai có kinh nghiệm với lỗi trên thì xin giúp đỡ. Em xin gửi riêng thông tin mailbox


View attachment 304748


View attachment 304745

Bắt đầu từ năm 2020: Gmail, microsoft Exchange hạn chế và không hỗ trợ việc dùng thư viện Collaboration Data Objects (CDO) của microsoft Window gửi Email, Bạn nên dùng outlook để thực hiện việc gửi Email
Code về cơ bản có dạng như sau:

Sub GuiMailHangLoat()
    Dim olApp As Outlook.Application ' bien ung dung outlut
    Dim olMail As Outlook.MailItem
    
    Set olApp = CreateObject("Outlook.Application")  ' gan bien
    Set olMail = olApp.CreateItem(olMailItem) ' gan mail
  ---------------------------- 
Dim i As Long, lr As Long
Dim MailNhan As String
Dim BodyMSG As String
Dim TieuDe As String
Dim FileDinhKem As String
---------------------------------
        ' Cau truc gui mai
        olMail.To = MailNhan ' gui cho ai (nguoi nhan)
        olMail.Subject = TieuDe ' tieu de mail
        olMail.Body = BodyMSG  ' phan than
        olMail.Attachments.Add FileDinhKem
        olMail.Send  ' lenh gui di
        MsgBox "Xong!"
End Sub

 

[MinhKhai]

Bắt đầu từ năm 2020: Gmail, microsoft Exchange hạn chế và không hỗ trợ việc dùng thư viện Collaboration Data Objects (CDO) của microsoft Window gửi Email, Bạn nên dùng outlook để thực hiện việc gửi Email
Code về cơ bản có dạng như sau:

Sub GuiMailHangLoat()
    Dim olApp As Outlook.Application ' bien ung dung outlut
    Dim olMail As Outlook.MailItem
   
    Set olApp = CreateObject("Outlook.Application")  ' gan bien
    Set olMail = olApp.CreateItem(olMailItem) ' gan mail
  ----------------------------
Dim i As Long, lr As Long
Dim MailNhan As String
Dim BodyMSG As String
Dim TieuDe As String
Dim FileDinhKem As String
---------------------------------
        ' Cau truc gui mai
        olMail.To = MailNhan ' gui cho ai (nguoi nhan)
        olMail.Subject = TieuDe ' tieu de mail
        olMail.Body = BodyMSG  ' phan than
        olMail.Attachments.Add FileDinhKem
        olMail.Send  ' lenh gui di
        MsgBox "Xong!"
End Sub

Cảm ơn bạn. Mail bên mình không hiểu nguyên nhân gì mà không được được với MS Outlook. Đã báo bộ phận IT nhưng họ không khắc phục được. May mắn mình dùng được với Thunderbird.
Vậy dùng Outlook gửi email theo code trên là bất khả thi bạn ạ.

 

[befaint]

Cứ có đủ thông tin máy chủ gửi và nhận của hệ thống mail là làm được mọi thứ.

IT đó không quản lý cái mail server kia rồi, nên không làm ăn gì được.

 

[HeSanbi]

@MinhKhai bạn thử sử dụng mã dưới đây, nhưng bạn cần tạo mã ứng dụng trong tài khoản Google. Để nhập mật khẩu cho mã.
Trong Outlook bạn đăng nhập Gmail và cần cấu hình như CDO nếu muốn gửi với Outlook.

Sub sendMail(WBname As String, emailAdd As String, billName As String)
  On Error GoTo ee
  Dim objCDOMsg As Object
  Dim objCDOSysCon As Object
  Set objCDOMsg = CreateObject("CDO.Message")
  Set objCDOSysCon = CreateObject("CDO.Configuration")
  ' CDO Configuration
  With objCDOSysCon.Fields
    .item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    .item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "*******************"
    .item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mật khẩu ứng dụng"
                           ' Sử dụng mật khẩu dành riêng cho ứng dụng đã tạo của bạn tại đây
    .item("http://schemas.microsoft.com/cdo/configuration/smtpusettls") = False
    .item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
    .Update
  End With
  ' CDO Message
  With objCDOMsg
    Set .Configuration = objCDOSysCon
    .Subject = "xxxxxxx"
    .from = "xxxxxxx"
    .To = emailAdd
    .TextBody = "xxxxxxx"
    .AddAttachment WBname
    .send
  End With
  Set objCDOMsg = Nothing
  Set objCDOSysCon = Nothing
  Exit Sub
ee:
  MsgBox "Error " & Err.number & ": " & Err.description
End Sub

 

[nguoiconxunui]

Hiện tại dùng các tài khoản microsoft, google...(phương thức SMTP, IMAP) không thể gửi mail qua xác thực thông thường là (user, password - kể cả app password) mà phải xác thực qua OAuth 2.

 

[befaint]

Windows giờ hịn hơn xưa rồi.
Mấy cái app Outlook, Outlook New, Mail của Windows 10, 11 được lập trình sẵn thư viện POP/IMAP SMTP của phần lớn dịch vụ mail thông dụng.
Cài đặt Gmail vào Outlook thì chỉ điền mỗi user name + password là xong, mọi thứ app làm sẵn hết ((nhớ là bật dịch vụ POP/IMAP của Gmail lên).

Đã nhắc là muốn trợ giúp thì cần nắm rõ thông tin của thành viên, đặc biệt là thông tin trong quá khứ.
Thớt làm việc cho công ty có đặc thù, không dùng Gmail gì sứt. Hệ thống mạng có tường lửa, không truy cập internet linh tinh, chỉ dùng cho phần mềm.
Mail của thớt là hệ thống mail nội bộ, có cấu hình riêng, phải dùng tới Thunderbird.

 

[MinhKhai]

@MinhKhai bạn thử sử dụng mã dưới đây, nhưng bạn cần tạo mã ứng dụng trong tài khoản Google. Để nhập mật khẩu cho mã.
Trong Outlook bạn đăng nhập Gmail và cần cấu hình như CDO nếu muốn gửi với Outlook.

Sub sendMail(WBname As String, emailAdd As String, billName As String)
  On Error GoTo ee
  Dim objCDOMsg As Object
  Dim objCDOSysCon As Object
  Set objCDOMsg = CreateObject("CDO.Message")
  Set objCDOSysCon = CreateObject("CDO.Configuration")
  ' CDO Configuration
  With objCDOSysCon.Fields
    .item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    .item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "*******************"
    .item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mật khẩu ứng dụng"
                           ' Sử dụng mật khẩu dành riêng cho ứng dụng đã tạo của bạn tại đây
    .item("http://schemas.microsoft.com/cdo/configuration/smtpusettls") = False
    .item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
    .Update
  End With
  ' CDO Message
  With objCDOMsg
    Set .Configuration = objCDOSysCon
    .Subject = "xxxxxxx"
    .from = "xxxxxxx"
    .To = emailAdd
    .TextBody = "xxxxxxx"
    .AddAttachment WBname
    .send
  End With
  Set objCDOMsg = Nothing
  Set objCDOSysCon = Nothing
  Exit Sub
ee:
  MsgBox "Error " & Err.number & ": " & Err.description
End Sub

Cảm ơn bạn.
Cái mình đang muốn là xử lý mail tổ chức, không phải mail của Google đâu bạn nhé