thắc mắc VBA gửi email từ file excel

wuhoatu

wuhoatu

Senior Member
Mình sử dụng đoạn code VBA dưới đây để tự gửi email (theo mẫu soạn sẵn trong file msg) kèm kết quả tính toán từ file excel. Vấn đề là chỉ gửi được từ email account mặc định của outlook. Nếu gửi bằng 1 tài khoản khác (cũng đã khai báo trong outlook) bằng SendUsingAccount thì báo lỗi "This message was created automatically by mail delivery software."
Các cao thủ vba/excel cho mình xin chút comment. Many THX
1684373193837.png

Code: 
Sub SendMail()

    Dim olApp As Outlook.Application
    Dim olMail As Outlook.MailItem
    Dim olAccount As Outlook.Account

    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItemFromTemplate("full_path_file_name.msg")

    Set olAccount = olApp.Session.Accounts("email_sender_here")
   
    With olMail
        .To = "[email protected]"
        .SendUsingAccount = olAccount
        .Send
    End With

    Set olMail = Nothing
    Set olApp = Nothing
    Set olAccount = Nothing
End Sub
 
SendUsingAccount trong .SendUsingAccount = olAccount là thuộc tính kiểu object cho nên bạn cần thêm từ khóa Set trước câu lệnh này nhé.
 
NguyenDang95 said:
SendUsingAccount trong .SendUsingAccount = olAccount là thuộc tính kiểu object cho nên bạn cần thêm từ khóa Set trước câu lệnh này nhé.
Click to expand...
Thx Thím. nhưng vấn đề ko phải nó lỗi ở câu lệnh mà email đã được đẩy lên server gửi nhưng server check mail đó chưa authenticated nên ko gửi đến server nhận.
 
wuhoatu said:
Thx Thím. nhưng vấn đề ko phải nó lỗi ở câu lệnh mà email đã được đẩy lên server gửi nhưng server check mail đó chưa authenticated nên ko gửi đến server nhận.
Click to expand...
Nếu đọc mô tả lỗi thì lỗi nằm ở địa chỉ email người nhận không chính xác, còn lại mình cũng chưa xác định lỗi nào khác.
 
NguyenDang95 said:
Nếu đọc mô tả lỗi thì lỗi nằm ở địa chỉ email người nhận không chính xác, còn lại mình cũng chưa xác định lỗi nào khác.
Click to expand...
Thx U thím. Địa chỉ mail đích chính xác. Thông báo lỗi nó dài quá nên mình chỉ capture 1 khúc đầu. Lỗi xảy ra như sau:
- Mở file excel và lần đầu chạy vba để gửi mail => OK, từ những lần gửi mail sau đó => Lỗi như trên, mail vào server nhưng ko đi ra khỏi server được.
Đã có giải pháp tạm thời:
- Manual gọi Outlook library vào Reference trước khi chạy macro, chạy xong remove Outlook library.
 
Code: 
Sub SendMail()
    Call ImportOutlookLib
    Call SendOutlookMail
    Call RemoveOutlookLib
End Sub

Private Sub ImportOutlookLib()
    Dim wbRef As Variant, wbRefFound As Boolean
    wbRefFound = False

    For Each wbRef In ThisWorkbook.VBProject.References
        Debug.Print wbRef.Description
        If wbRef.Description = "Microsoft Outlook 14.0 Object Library" Then
            wbRefFound = True
            Exit For
        End If
    Next

    If wbRefFound = False Then
        Dim Reference As Object
        Dim OLB As String
        Dim Vmajor, Vminor

        OLB14 = "{00062FFF-0000-0000-C000-000000000046}"
        Vmajor14 = 9: Vminor14 = 4

        ThisWorkbook.VBProject.References.AddFromGuid OLB14, Vmajor14, Vminor14
    End If
End Sub

Private Sub RemoveOutlookLib()
    Dim wbRef As Variant

    For Each wbRef In ThisWorkbook.VBProject.References
        Debug.Print wbRef.Description
        If wbRef.Description = "Microsoft Outlook 14.0 Object Library" Then
            ThisWorkbook.VBProject.References.Remove (wbRef)
            Exit For
        End If
    Next
End Sub

Private Sub SendOutlookMail()
    Dim olApp As Outlook.Application
    Dim olMail As Outlook.MailItem
    Dim olAccount As Outlook.Account

    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItemFromTemplate("full_path_file_name.msg")

    Set olAccount = olApp.Session.Accounts("[email protected]")
    
    With olMail
        .To = "[email protected]"
        .SendUsingAccount = olAccount
        .Send
    End With

    Set olAccount = Nothing
    Set olMail = Nothing
    Set olApp = Nothing
End Sub
 
wuhoatu said:
Thx U thím. Địa chỉ mail đích chính xác. Thông báo lỗi nó dài quá nên mình chỉ capture 1 khúc đầu. Lỗi xảy ra như sau:
- Mở file excel và lần đầu chạy vba để gửi mail => OK, từ những lần gửi mail sau đó => Lỗi như trên, mail vào server nhưng ko đi ra khỏi server được.
Đã có giải pháp tạm thời:
- Manual gọi Outlook library vào Reference trước khi chạy macro, chạy xong remove Outlook library.
Click to expand...
Có thể thím nên đổi code này
Set olApp = CreateObject("Outlook.Application")
Thành
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Như vậy, trước khi chạy macro thì nên mở ứng dụng Outlook để cho Outlook có thời gian đăng nhập, đồng bộ các thư mục email nhằm tránh phát sinh những lỗi không đáng có.
 
Last edited:
NguyenDang95 said:
Có thể thím nên đổi code này
Set olApp = CreateObject("Outlook.Application")
Thành
On Error Resume Next
Set olApp = CreateObject("Outlook.Application")
If Err.Number = 429 Then
Set olApp = GetObject(, "Outlook.Application")
End If
On Error GoTo 0
Như vậy, trước khi chạy macro thì nên mở ứng dụng Outlook để cho Outlook có thời gian đăng nhập, đồng bộ các thư mục email nhằm tránh phát sinh những lỗi không đáng có.
Click to expand...
Ko ăn thua thím ơi, mở outlook hay ko thì từ lần thứ 2 gửi mail bằng vba (nếu ko đóng file excel đang chạy) đều bị lỗi, mà ko báo lỗi code luôn vì mail vẫn đc đẩy lên server thành công. Chỉ là server nó check chính cái mail đó và nó báo mail đc khởi tạo auto bằng phần mềm khác outlook (ko authenticated) nên ko cho đi.
 
wuhoatu said:
Ko ăn thua thím ơi, mở outlook hay ko thì từ lần thứ 2 gửi mail bằng vba (nếu ko đóng file excel đang chạy) đều bị lỗi, mà ko báo lỗi code luôn vì mail vẫn đc đẩy lên server thành công. Chỉ là server nó check chính cái mail đó và nó báo mail đc khởi tạo auto bằng phần mềm khác outlook (ko authenticated) nên ko cho đi.
Click to expand...
Vậy thím có thể cho mình xem qua code được không, để mình tìm nguyên nhân gây ra lỗi.
 
NguyenDang95 said:
Vậy thím có thể cho mình xem qua code được không, để mình tìm nguyên nhân gây ra lỗi.
Click to expand...
Code vba đây thím https://voz.vn/t/vba-gui-email-tu-file-excel.775121/#post-25350390
Thông báo lỗi:
Code: 
Reporting-MTA: dns; mail.maychuemail.com

Action: failed
Final-Recipient: rfc822;[email protected]
Status: 5.0.0
Remote-MTA: dns; gmail-smtp-in.l.google.com
Diagnostic-Code: smtp; 550-5.7.26 This mail is unauthenticated, which poses a security risk to the
 550-5.7.26 sender and Gmail users, and has been blocked. The sender must
 550-5.7.26 authenticate with at least one of SPF or DKIM. For this message,
 550-5.7.26 DKIM checks did not pass and SPF check for [exdesign.com.vn] did not
 550-5.7.26 pass with ip: [112.213.90.104]. The sender should visit
 550-5.7.26  https://support.google.com/mail/answer/81126#authentication for
 550 5.7.26 instructions on setting up authentication. j15-20020a637a4f000000b00518db33cf17si726794pgn.552 - gsmtp
Code: 
This message was created automatically by mail delivery software.

A message that you sent could not be delivered to one or more of its
recipients. This is a permanent error. The following address(es) failed:

[email protected]
host gmail-smtp-in.l.google.com [64.233.188.26]
SMTP error from remote mail server after end of data:
550-5.7.26 This mail is unauthenticated, which poses a security risk to the
550-5.7.26 sender and Gmail users, and has been blocked. The sender must
550-5.7.26 authenticate with at least one of SPF or DKIM. For this message,
550-5.7.26 DKIM checks did not pass and SPF check for [exdesign.com.vn] did not
550-5.7.26 pass with ip: [112.213.90.104]. The sender should visit
550-5.7.26  https://support.google.com/mail/answer/81126#authentication for
550 5.7.26 instructions on setting up authentication. j15-20020a637a4f000000b00518db33cf17si726794pgn.552 - gsmtp
 
wuhoatu said:
Code vba đây thím https://voz.vn/t/vba-gui-email-tu-file-excel.775121/#post-25350390
Thông báo lỗi:
Code: 
Reporting-MTA: dns; mail.maychuemail.com

Action: failed
Final-Recipient: rfc822;[email protected]
Status: 5.0.0
Remote-MTA: dns; gmail-smtp-in.l.google.com
Diagnostic-Code: smtp; 550-5.7.26 This mail is unauthenticated, which poses a security risk to the
 550-5.7.26 sender and Gmail users, and has been blocked. The sender must
 550-5.7.26 authenticate with at least one of SPF or DKIM. For this message,
 550-5.7.26 DKIM checks did not pass and SPF check for [exdesign.com.vn] did not
 550-5.7.26 pass with ip: [112.213.90.104]. The sender should visit
 550-5.7.26  https://support.google.com/mail/answer/81126#authentication for
 550 5.7.26 instructions on setting up authentication. j15-20020a637a4f000000b00518db33cf17si726794pgn.552 - gsmtp
Code: 
This message was created automatically by mail delivery software.

A message that you sent could not be delivered to one or more of its
recipients. This is a permanent error. The following address(es) failed:

[email protected]
host gmail-smtp-in.l.google.com [64.233.188.26]
SMTP error from remote mail server after end of data:
550-5.7.26 This mail is unauthenticated, which poses a security risk to the
550-5.7.26 sender and Gmail users, and has been blocked. The sender must
550-5.7.26 authenticate with at least one of SPF or DKIM. For this message,
550-5.7.26 DKIM checks did not pass and SPF check for [exdesign.com.vn] did not
550-5.7.26 pass with ip: [112.213.90.104]. The sender should visit
550-5.7.26  https://support.google.com/mail/answer/81126#authentication for
550 5.7.26 instructions on setting up authentication. j15-20020a637a4f000000b00518db33cf17si726794pgn.552 - gsmtp
Click to expand...
Sau khi xem log thì mình nghĩ lỗi không phải từ phía macro VBA, việc thêm/bỏ tham chiếu đến thư viện của Outlook cũng không có tác dụng gì, căn bản là code của macro khởi tạo đối tượng Outlook.Application theo kiểu late binding cho nên việc tham chiếu hay không thì code vẫn chạy.
Thím nên truy cập vào địa chỉ https://support.google.com/mail/answer/81126#authentication để xem tài khoản mail của mình có vấn đề gì mà Google lại chặn không cho gửi mail đi.
 
Green Lantern_Hal Jordan said:
Bác có thể làm 01 bài viết cập nhật code VBA từ xa không
Click to expand...
Cập nhật code VBA từ xa có vẻ không khả thi cho lắm nhé thím, điều này phụ thuộc vào cài đặt bảo mật của Excel cho phép macro truy cập/chỉnh sửa code của một VBA project nào đó (mặc định: bị vô hiệu hóa).
1684410074642.png
 
NguyenDang95 said:
Sau khi xem log thì mình nghĩ lỗi không phải từ phía macro VBA, việc thêm/bỏ tham chiếu đến thư viện của Outlook cũng không có tác dụng gì, căn bản là code của macro khởi tạo đối tượng Outlook.Application theo kiểu late binding cho nên việc tham chiếu hay không thì code vẫn chạy.
Thím nên truy cập vào địa chỉ https://support.google.com/mail/answer/81126#authentication để xem tài khoản mail của mình có vấn đề gì mà Google lại chặn không cho gửi mail đi.
Click to expand...
Mình cũng nghĩ ko phải do code của VBA.
Nó báo google chặn thế thôi, nhưng nếu ko xài SendUsingAccount mà chứ để gửi theo account mặc đình thì 100% vào inbox mới cay.
Chưa có giải pháp triệt để nên tạm thời chơi kiểu lông zân là manual add /remove Outlook lib vậy.
 
Gửi bằng tài khoản gmail, không cần cài outlook, đọc dữ liệu từ excel gán vào nội dung email rồi gửi, đã test ok. Nhược điểm là phải tạo password app cho gmail để add vào code, chỉ làm 1 lần là được

Sub Send_Emails()
Dim NewMail As CDO.Message
Dim mailConfig As CDO.Configuration
Dim fields As Variant
Dim msConfigURL As String
On Error GoTo Err:
rowData = ActiveSheet.Cells(Rows.count, "A").End(xlUp).Row
For i = 2 To rowData
'early binding
Set NewMail = New CDO.Message
Set mailConfig = New CDO.Configuration
emailADD = Range("A" & i).Value
subjectEmail = Range("B" & i).Value
textEmail = Range("C" & i).Value
'load all default configurations
mailConfig.Load -1

Set fields = mailConfig.fields

'Set All Email Properties
With NewMail
.From = "[email protected]" 'your email address
.To = emailADD
.CC = ""
.BCC = ""
.Subject = subjectEmail
.TextBody = textEmail
' .Addattachment "c:confused:data\email.xlsx" 'Optional file attachment; remove if not needed.
' .Addattachment "c:confused:data\email.pdf" 'Duplicate the line for a second attachment.
End With

msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

With fields
.Item(msConfigURL & "/smtpusessl") = True 'Enable SSL Authentication
.Item(msConfigURL & "/smtpauthenticate") = 1 'SMTP authentication Enabled
.Item(msConfigURL & "/smtpserver") = "smtp.gmail.com" 'Set the SMTP server details
.Item(msConfigURL & "/smtpserverport") = 465 'Set the SMTP port Details
.Item(msConfigURL & "/sendusing") = 2 'Send using default setting
.Item(msConfigURL & "/sendusername") = "[email protected]" 'Your gmail address
.Item(msConfigURL & "/sendpassword") = "xfqwwuoeezcmjage" 'Your password or App Password
.Update 'Update the configuration fields
End With
NewMail.Configuration = mailConfig
NewMail.Send

' MsgBox "Your email has been sent", vbInformation
Set NewMail = Nothing
Set mailConfig = Nothing
Next
Exit_Err:
'Release object memory
Set NewMail = Nothing
Set mailConfig = Nothing
End

Err:
Select Case Err.Number
Case -2147220973 'Could be because of Internet Connection
MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
Case -2147220975 'Incorrect credentials User ID or password
MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
Case Else 'Report other errors
MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
End Select

Resume Exit_Err

End Sub
 

Similar threads

wuhoatu
thảo luận VBA gửi mail bằng outlook với HTML format
Replies
7
Views
472
wuhoatu
wuhoatu
NguyenDang95
kiến thức [Excel VBA] Làm việc với SharePoint List
Replies
2
Views
2K
Louisnghia
Louisnghia
NguyenDang95
thảo luận [Office VBA] Chia sẻ với mọi người thư viện được viết bằng VBA giúp tương tác với SharePoint
Replies
2
Views
1K
NguyenDang95
NguyenDang95
NguyenDang95
kiến thức [Office VBA] Tương tác với SharePoint và giải quyết một số yêu cầu thường thấy của người dùng
Replies
6
Views
2K
NguyenDang95
NguyenDang95
NguyenDang95
kiến thức [Excel VBA] (Linh tinh) Xác thực OAuth2 để triển khai các dịch vụ của Google trên Excel
Replies
3
Views
2K
NguyenDang95
NguyenDang95

Share this page

Back
Top