Code gửi email trong access

Send email from MS Access using VBA and SMTP protocol
To better demonstrate how to send email using SMTP protocol in Access + VBA, let’s open MS Access, select blank database, and name it as Sample.accdb. Create a table named Users like this:
After you input the data, create a form named Users_From like this:
Menu -> Create -> Multiple Items
Right click Users_Form -> Design View, Add two buttons by Design -> Select Button control:
When you put the button on the form, it will popup a dialog box, simply click Cancel, then right click the button -> properties, set first button name to btnSend and Caption to Send Mail, set second button name to btnCancel and Caption to Cancel.
Please also add an extra button named btnFocus, and put it to anywhere on the form, it is used to help setting focus for other buttons.
Installation
EASendMail is a SMTP component which supports all operations of SMTP/ESMTP protocols (RFC 821, RFC 822, RFC 2554). Before you can use the following example codes, you should download the EASendMail Installer and install it on your machine at first.
Add Reference
To use EASendMail SMTP ActiveX Object in VBA project, the first step is “Add reference of EASendMail to your project”. Open VBA IDE by press Alt+F11, Please select menu -> Tools -> References -> and select EASendMailObj ActiveX Object, click OK, the reference will be added to current VBA project, and you can start to use it to send email in your project.

[Access + VBA - Send email - Example]
After the reference is added, click Form_Users_From and input the following codes:
Please enable Macro if you closed and re-opened this database, otherwise the codes cannot be executed.
Important
You need to access the Trust Center in the Access Options dialog box. Click the Microsoft Office Button, and then click Access Options. In the Trust Center category, click Trust Center Settings, and then click the Macro Settings category.



' To use the following codes, please download and install
' https://www.emailarchitect.net/webapp/download/easendmail.exe on your machine

Option Compare Database

Private WithEvents oSmtp As EASendMailObjLib.Mail
Private CurrentEmailIsFinished As Boolean
Private HasErrorWithEmail As Boolean
Private ErrorDescription As String
Private CancelSending As Boolean

Private Sub InitVariables()
    CurrentEmailIsFinished = True
    HasErrorWithEmail = False
    ErrorDescription = ""
    CancelSending = False
End Sub

Private Sub btnCancel_Click()
    btnFocus.SetFocus
    btnCancel.Enabled = False
    If Not (oSmtp Is Nothing) Then
        oSmtp.Terminate
        CancelSending = True
        CurrentEmailIsFinished = True
    End If
End Sub

Private Sub Form_Load()
    btnCancel.Enabled = False
    btnSend.Enabled = True
    btnFocus.TabStop = False
    btnFocus.Transparent = True
    InitVariables
End Sub

Private Sub btnSend_Click()
    btnFocus.SetFocus
    btnCancel.Enabled = True
    btnSend.Enabled = False

    SendMailFromAccess

    btnCancel.Enabled = False
    btnSend.Enabled = True
End Sub

Private Sub oSmtp_OnAuthenticated()
    SysCmd acSysCmdSetStatus, "Authenticated"
End Sub

Private Sub oSmtp_OnClosed()
    CurrentEmailIsFinished = True
End Sub

Private Sub oSmtp_OnConnected()
    SysCmd acSysCmdSetStatus, "Connected"
End Sub

Private Sub oSmtp_OnError(ByVal lError As Long, ByVal ErrDescription As String)
    HasErrorWithEmail = True
    CurrentEmailIsFinished = True
    ErrorDescription = ErrDescription
End Sub

Private Sub oSmtp_OnSending(ByVal lSent As Long, ByVal lTotal As Long)
    SysCmd acSysCmdSetStatus, "Sending " & lSent & "/" & lTotal & " ..."
End Sub

Public Sub SendMailFromAccess()

    Dim sender, Name, address, subject, bodyTemplate, body, bodyFormat
    bodyFormat = 0 'Text body format

    ' Please change sender address to yours
    sender = "test@emailarchitect.net"
    subject = "Test email from MS Access and VBA"

    ' Use a body template to build body text based on recipient's name
    bodyTemplate = "Dear {name}," & Chr(13) & Chr(10) & Chr(13) & Chr(10) & _
        "This is a test email from MS Access using VBA, do not reply."

    Dim rs, sql
    Set rs = CreateObject("ADODB.Recordset")

    sql = Me.RecordSource
    If Me.FilterOn Then
        sql = sql & " WHERE " & Me.Filter
    End If

    rs.Open sql, CurrentProject.Connection
    rs.MoveFirst

    Dim emailSent
    emailSent = 0

    Do While Not rs.EOF
        Name = Trim(rs!Name)
        address = Trim(rs!Email)
        body = Replace(bodyTemplate, "{name}", Name)

        If Not SendMailTo(sender, Name, address, subject, body, bodyFormat) Then
            Exit Sub
        End If

        emailSent = emailSent + 1
        rs.MoveNext

    Loop

    SysCmd acSysCmdSetStatus, "Total " & emailSent & " email(s) sent."

End Sub

Function SendMailTo(sender, Name, address, subject, body, bodyFormat)

    Set oSmtp = New EASendMailObjLib.Mail
    oSmtp.LicenseCode = "TryIt"

    ' Please change server address, user, password to yours
    oSmtp.ServerAddr = "mail.emailarchitect.net"
    oSmtp.UserName = "test@emailarchitect.net"
    oSmtp.Password = "yourpassword"

    ' Set server port, if 25 port doesn't work, try to use 587 port
    oSmtp.ServerPort = 25

    ' Using TryTLS,
    ' If smtp server supports TLS, then TLS connection is used; otherwise, normal TCP connection is used.
    ' https://www.emailarchitect.net/easendmail/sdk/?ct=connecttype
    oSmtp.ConnectType = 4

    ' If your server is Exchange 2007 or later version, you can use EWS protocol.
    ' https://www.emailarchitect.net/easendmail/sdk/?ct=protocol
    ' Set Exchange Web Service Protocol - EWS - Exchange 2007/2010/2013/2016
    ' oSmtp.Protocol = 1

    oSmtp.FromAddr = sender
    oSmtp.AddRecipient Name, address, 0

    oSmtp.subject = subject
    oSmtp.bodyFormat = bodyFormat
    oSmtp.BodyText = body

    ' You can add attachment like this:
    ' Add attachment from local disk
    ' If oSmtp.AddAttachment("d:\test.jpg") <> 0 Then
        ' Application.StatusBar = "Failed to add attachment with error:" & oSmtp.GetLastErrDescription()
        ' SendMailTo = False
        ' Exit Function
    'End If

    SysCmd acSysCmdSetStatus, "Connecting " & oSmtp.ServerAddr & " ..."

    oSmtp.Asynchronous = 1
    InitVariables
    CurrentEmailIsFinished = False
    oSmtp.SendMail

    Do While Not CurrentEmailIsFinished
        ' Wait for the email sending, you can do other thing here
        DoEvents
    Loop

    If CancelSending Then
        SysCmd acSysCmdSetStatus, "Operation was terminated by user!"
        SendMailTo = False
    ElseIf HasErrorWithEmail Then
        SysCmd acSysCmdSetStatus, "Failed to send email to " & address & "; " & ErrorDescription
        SendMailTo = False
    Else
        SysCmd acSysCmdSetStatus, "Message to " & address & " has been submitted to server."
        SendMailTo = True
    End If

    Set oSmtp = Nothing
End Function

Close VBA IDE and back to Access, double click this form to display the form, and then click Send Mail.

You will see the status and result at Access status bar.