You can send email using traditional user/password authentication from Office 365 account by SMTP/EWS Protocol.
However Microsoft will disable traditional user authentication in the future, switching to Microsoft OAuth (Modern Authentication) is strongly recommended now.
Sections:
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.
To use EASendMail SMTP ActiveX Object in your project, the first step is “Add reference
of EASendMail to your project”. Please select menu -> Project
-> References
->
and select EASendMailObj ActiveX Object
, click OK
, the reference will be added
to current project, and you can start to use it to send email in your VB6 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 VBA project.
To use Microsoft/Office365/Live OAuth (Modern Authentication) in your application, you must create a application in Azure Portal.
Azure portal
using either a work or school account or a personal Microsoft account.Azure AD tenant
that you want.Search Microsoft Entra ID
(old name “Azure Active Directory”) and go to this service:
In the left-hand navigation pane, select the Microsoft Entra ID
service, and then select -> Manage
-> App registrations
-> New registration
.
Input a name to to register the application:
When the register an application page appears, enter a meaningful application name and select the account type.
Select which accounts you would like your application to support.
Single tenant
type;Multitenant
type, and you must verify publisher.Because we want to support all Office 365 and
LIVE SDK (hotmail, outlook personal account), so select
Accounts in any organizational directory and personal Microsoft accounts
.
Important
If you don’t verify publisher for multitenant application, your application will not request access token successfully.
Now you need to assign API permission to the application by clicking Manage
-> API Permission
-> Add a permission
.
You don’t have to assign all the API permissions below to the application, just assign the API permission(s) you need.
Protocol | Permission | Scope | |
Graph API | Mail.Send, Mail.ReadWrite | https://graph.microsoft.com/Mail.Send, https://graph.microsoft.com/Mail.ReadWrite | |
EWS | EWS.AccessAsUser.All | https://outlook.office.com/EWS.AccessAsUser.All | |
SMTP | SMTP.Send | https://outlook.office365.com/SMTP.Send | |
POP | POP.AccessAsUser.All | https://outlook.office365.com/POP.AccessAsUser.All | |
IMAP | IMAP.AccessAsUser.All | https://outlook.office365.com/IMAP.AccessAsUser.All |
Now we need to add permission to the application:
Manage
-> API Permission
->Add a permission
->
Microsoft Graph
-> Delegated Permission
-> User.Read
,
email
, offline_access
, openid
, profile
, SMTP.Send
,
IMAP.AccessAsUser.All
, POP.AccessAsUser.All
, Mail.Send
, Mail.ReadWrite
.With the above permissions, your application can support SMTP, POP, IMAP and Ms Graph API service. If your application needs to support EWS protocol either, add EWS permission like this:
Manage
-> API Permission
->Add a permission
-> APIs in my organization uses
-> Office 365 Exchange Online
-> Delegated Permission
->
Check EWS.AccessAsUser.All
Here is permissions list:
Because the example code is based on desktop application, so add Redirect Uri
like this:
Click Manage
-> "Authentication"
-> Add a platform
-> Mobile and desktop applications
-> Redirect Uri
, please check or add the following URI.
https://login.microsoftonline.com/common/oauth2/nativeclient
https://login.microsoftonline.com/common/oauth2/nativeclient
http://127.0.0.1
Note
https://login.microsoftonline.com/common/oauth2/nativeclient
is used for Live SDK, http://127.0.0.1
is used for local Http Listener.If your application needs to support Microsoft personal account, set both "Live SDK Support"
and "Treat application as a public client"
to "Yes"
.
Now we need to create a client secret for the application,
click Manage
-> Certificates and secrets
-> client secrets
and add a new client secret
.
After client secret is created, store the client secret value to somewhere.
Important
Please store client secret value
by yourself, because it is hidden when you view it at next time.
Now we click Branding
, you can edit your company logo
, URL
and application name
. If your application supports
multitenant (access user in all Office 365 and Microsoft personal account), you must complete the publisher verification
.
It is not difficult, you can have a look at publisher verification. After publisher verification is completed, your branding is like this:
Important
You must complete the publisher verification for multitenant application, otherwise, your application will not request access token correctly.
Now you can click Overview
to find your client id
and tenant
.
single tenant
, use the tenant value in tokenUri
and authUri
instead of common
.multitenant
, use common
as tenant.Above client id
and client secret
support both "Office365 + SMTP/EWS"
and
"Live (hotmail, outlook personal account) + SMTP"
.
Because HttpWebRequest is used to get access token from web service.
If you’re using .NET framework (.NET 2.0 - 3.5 and .NET 4.x),
you need to enable Strong Encryption Algorithms
to request access token:
Put the following content to a file named NetStrongEncrypt.reg
, right-click this file -> Merge
-> Yes
.
You can also download it from https://www.emailarchitect.net/webapp/download/NetStrongEncrypt.zip.
Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\.NETFramework\v2.0.50727]
"SystemDefaultTlsVersions"=dword:00000001
"SchUseStrongCrypto"=dword:00000001
[HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\.NETFramework\v2.0.50727]
"SystemDefaultTlsVersions"=dword:00000001
"SchUseStrongCrypto"=dword:00000001
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\.NETFramework\v4.0.30319]
"SystemDefaultTlsVersions"=dword:00000001
"SchUseStrongCrypto"=dword:00000001
[HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\.NETFramework\v4.0.30319]
"SystemDefaultTlsVersions"=dword:00000001
"SchUseStrongCrypto"=dword:00000001
You can use client id and client secret to get the user email address and access token like this:
EASendMail Installation Path\Samples_{Programming language/Developer Tool}\Oauth
project.You don’t have to open browser to request access token
every time. By default,
access token
expiration time is 3600 seconds, you can use the access token
repeatedly before it is expired.
After it is expired, you can use refresh token
to refresh access token
directly without opening browser.
You can find full sample project in EASendMail installation path
to learn how to refresh token
.
Important
You should create your client id
and client secret
, do not use the client id
from example codes in production environment,
it is used for test purpose. If you got "This app isn't verified"
information, please click "Advanced"
-> Go to ...
for test.
Here is a simple application which demonstrates how to use Microsoft OAuth to do user authentication and send email with SMTP protocol.
Note
This sample cannot handle the event of Web Browser is closed by user manually before authentication is completed.
You can refer to the better sample project which uses Web Browser Control
in EASendMail installation path.
Option Explicit
Const ConnectNormal = 0
Const ConnectSSLAuto = 1
Const ConnectSTARTTLS = 2
Const ConnectDirectSSL = 3
Const ConnectTryTLS = 4
Const AuthAuto = -1
Const AuthLogin = 0
Const AuthNtlm = 1
Const AuthCramMd5 = 2
Const AuthPlain = 3
Const AuthMsn = 4
Const AuthXoauth2 = 5
' client configuration
' You should create your client id and client secret,
' do not use the following client id in production environment, it is used for test purpose only.
Const clientID = "eccbabb2-3377-4265-85c1-ea2fb515f075"
Const clientSecret = "QaR_RR:-5WqTY[nni9pdBr9xVybqrAu4"
' set SMTP scopde
Const scope = "https://outlook.office.com/SMTP.Send%20offline_access%20email%20openid"
Const authUri = "https://login.microsoftonline.com/common/oauth2/v2.0/authorize"
Const tokenUri = "https://login.microsoftonline.com/common/oauth2/v2.0/token"
' if your application is single tenant, please use tenant id instead of common in authUri and tokenUri
' for example, your tenant is 669595d0-a4d7-47c5-8040-cf9970400e48, then
' Const authUri = "https://login.microsoftonline.com/669595d0-a4d7-47c5-8040-cf9970400e48/oauth2/v2.0/authorize"
' Const tokenUri = "https://login.microsoftonline.com/669595d0-a4d7-47c5-8040-cf9970400e48/oauth2/v2.0/token"
Public Sub DoOauthAndSendEmail()
Dim httpListener As New EASendMailObjLib.httpListener
' Creates a redirect URI using an available port on the loopback address.
If Not httpListener.Create("127.0.0.1", 0) Then
Debug.Print "Failed to listen on " & httpListener.GetLastError()
Exit Sub
End If
Dim szUri
szUri = "http://127.0.0.1:" & httpListener.ListenPort
Debug.Print "listen on " & szUri
' Creates the OAuth 2.0 authorization request.
Dim authorizationRequest
authorizationRequest = authUri
authorizationRequest = authorizationRequest & "?response_type=code&scope="
authorizationRequest = authorizationRequest & scope
authorizationRequest = authorizationRequest & "&redirect_uri="
authorizationRequest = authorizationRequest & szUri
authorizationRequest = authorizationRequest & "&client_id="
authorizationRequest = authorizationRequest & clientID
authorizationRequest = authorizationRequest & "&prompt=login"
Debug.Print "open " & authorizationRequest
' Opens request in the browser.
Dim browserUi As New EASendMailObjLib.browserUi
browserUi.OpenUrl authorizationRequest
' Waits for the OAuth authorization response.
Do While True
If Not httpListener.GetRequestUrl(100) Then
Debug.Print "Failed to wait:"
Debug.Print httpListener.GetLastError()
Exit Do
End If
If httpListener.RequestUrl <> "" Then
Exit Do
End If
DoEvents
Loop
' Send response and stop http listener.
httpListener.SendResponse "200", "text/html; charset=utf-8", "<html><head></head><body>Please return to the app and close current window.</body></html>"
httpListener.Close
Dim requestUri
requestUri = httpListener.RequestUrl
Debug.Print "RequestUri: " & requestUri
Dim errorCode
' Checks for errors.
errorCode = ParseParameter(requestUri, "error=")
If errorCode <> "" Then
Debug.Print "OAuth authorization error: " & errorCode
Exit Sub
End If
' Check authorization code
Dim code
code = ParseParameter(requestUri, "code=")
If code = "" Then
Debug.Print "Malformed authorization response: " & requestUri
Exit Sub
End If
Debug.Print "Authorization code: " & code
Dim responseText
responseText = RequestAccessToken(code, szUri)
Debug.Print responseText
Dim parser As New EASendMailObjLib.OAuthResponseParser
parser.Load responseText
Dim user, accessToken
user = parser.EmailInIdToken
accessToken = parser.accessToken
If accessToken = "" Then
Debug.Print "Failed to request access token, return!"
Exit Sub
End If
Debug.Print "User: " & user
Debug.Print "AccessToken: " & accessToken
SendMailWithXOAUTH2 user, accessToken
End Sub
' path?parameter1=value1¶meter2=value2#anchor;
Private Function ParseParameter(ByVal uri As String, ByVal key As String) As String
ParseParameter = ""
If uri = "" Or key = "" Then
Exit Function
End If
Dim pos As Integer
pos = InStr(1, uri, "?")
If pos <= 0 Then
Exit Function
End If
uri = Mid(uri, pos + 1)
Dim i, parameters, uriParameter
parameters = Split(uri, "&")
For i = LBound(parameters) To UBound(parameters)
uriParameter = parameters(i)
If InStr(1, uriParameter, key, vbTextCompare) = 1 Then
Dim value
value = Mid(uriParameter, Len(key) + 1)
pos = InStr(1, value, "#")
If pos > 0 Then
value = Mid(value, 1, pos - 1)
End If
ParseParameter = value
Exit Function
End If
Next
End Function
Private Function RequestAccessToken(ByVal code As String, ByVal redirectUri As String) As String
Debug.Print "Exchanging code for tokens..."
RequestAccessToken = ""
Dim responseText
responseText = ""
Dim httpRequest
Set httpRequest = CreateObject("MSXML2.ServerXMLHTTP.6.0")
Dim tokenRequestBody
tokenRequestBody = "code="
tokenRequestBody = tokenRequestBody & code
tokenRequestBody = tokenRequestBody & "&redirect_uri="
tokenRequestBody = tokenRequestBody & redirectUri
tokenRequestBody = tokenRequestBody & "&client_id="
tokenRequestBody = tokenRequestBody & clientID
tokenRequestBody = tokenRequestBody & "&grant_type=authorization_code"
' If you request access token in web application, you must add client secret in token request data
' tokenRequestBody = "code="
' tokenRequestBody = tokenRequestBody & code
' tokenRequestBody = tokenRequestBody & "&redirect_uri="
' tokenRequestBody = tokenRequestBody & redirectUri
' tokenRequestBody = tokenRequestBody & "&client_id="
' tokenRequestBody = tokenRequestBody & clientID
' tokenRequestBody = tokenRequestBody & "&client_secret="
' tokenRequestBody = tokenRequestBody & clientSecret
' tokenRequestBody = tokenRequestBody & "&grant_type=authorization_code"
httpRequest.setOption 2, 13056
httpRequest.Open "POST", tokenUri, True
httpRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
httpRequest.Send tokenRequestBody
Do While httpRequest.ReadyState <> 4
DoEvents
httpRequest.waitForResponse (1)
Loop
Dim Status
Status = httpRequest.Status
responseText = httpRequest.responseText
RequestAccessToken = responseText
If Status < 200 Or Status >= 300 Then
Debug.Print "Failed to refresh access token from server."
End If
End Function
Private Sub SendMailWithXOAUTH2(ByVal userEmail As String, ByVal accessToken As String)
Dim oSmtp As New EASendMailObjLib.Mail
oSmtp.LicenseCode = "TryIt"
' Office 365 server address
oSmtp.ServerAddr = "outlook.office365.com"
' Using 587 port, you can also use 465 or 25 port
oSmtp.ServerPort = 587
' Enable SSL/TLS connection
oSmtp.ConnectType = ConnectSSLAuto
' OAUTH/XOAUTH2 type
oSmtp.AuthType = AuthXoauth2
' set user authentication
oSmtp.UserName = userEmail
' use access token as password
oSmtp.Password = accessToken
' Your email address
oSmtp.FromAddr = userEmail
' Please change recipient address to yours for test
oSmtp.AddRecipient "Support Team", "support@emailarchitect.net", 0
oSmtp.Subject = "Test email using Office365 Oauth"
oSmtp.BodyText = "Hello, this is a test...."
Debug.Print "start to send email using OAUTH 2.0 ..."
If oSmtp.SendMail() = 0 Then
Debug.Print "The email has been submitted to server successfully!"
Else
Debug.Print oSmtp.GetLastErrDescription()
End If
End Sub
Here is a simple application which demonstrates how to use Microsoft OAuth to do user authentication and send email with EWS protocol.
Note
This sample cannot handle the event of Web Browser is closed by user manually before authentication is completed.
You can refer to the better sample project which uses Web Browser Control
in EASendMail installation path.
Option Explicit
Const ConnectNormal = 0
Const ConnectSSLAuto = 1
Const ConnectSTARTTLS = 2
Const ConnectDirectSSL = 3
Const ConnectTryTLS = 4
Const AuthAuto = -1
Const AuthLogin = 0
Const AuthNtlm = 1
Const AuthCramMd5 = 2
Const AuthPlain = 3
Const AuthMsn = 4
Const AuthXoauth2 = 5
' client configuration
' You should create your client id and client secret,
' do not use the following client id in production environment, it is used for test purpose only.
Const clientID = "eccbabb2-3377-4265-85c1-ea2fb515f075"
Const clientSecret = "QaR_RR:-5WqTY[nni9pdBr9xVybqrAu4"
' set EWS scope
Const scope = "https://outlook.office.com/EWS.AccessAsUser.All%20offline_access%20email%20openid"
Const authUri = "https://login.microsoftonline.com/common/oauth2/v2.0/authorize"
Const tokenUri = "https://login.microsoftonline.com/common/oauth2/v2.0/token"
' if your application is single tenant, please use tenant id instead of common in authUri and tokenUri
' for example, your tenant is 669595d0-a4d7-47c5-8040-cf9970400e48, then
' Const authUri = "https://login.microsoftonline.com/669595d0-a4d7-47c5-8040-cf9970400e48/oauth2/v2.0/authorize"
' Const tokenUri = "https://login.microsoftonline.com/669595d0-a4d7-47c5-8040-cf9970400e48/oauth2/v2.0/token"
Public Sub DoOauthAndSendEmail()
Dim httpListener As New EASendMailObjLib.httpListener
' Creates a redirect URI using an available port on the loopback address.
If Not httpListener.Create("127.0.0.1", 0) Then
Debug.Print "Failed to listen on " & httpListener.GetLastError()
Exit Sub
End If
Dim szUri
szUri = "http://127.0.0.1:" & httpListener.ListenPort
Debug.Print "listen on " & szUri
' Creates the OAuth 2.0 authorization request.
Dim authorizationRequest
authorizationRequest = authUri
authorizationRequest = authorizationRequest & "?response_type=code&scope="
authorizationRequest = authorizationRequest & scope
authorizationRequest = authorizationRequest & "&redirect_uri="
authorizationRequest = authorizationRequest & szUri
authorizationRequest = authorizationRequest & "&client_id="
authorizationRequest = authorizationRequest & clientID
authorizationRequest = authorizationRequest & "&prompt=login"
Debug.Print "open " & authorizationRequest
' Opens request in the browser.
Dim browserUi As New EASendMailObjLib.browserUi
browserUi.OpenUrl authorizationRequest
' Waits for the OAuth authorization response.
Do While True
If Not httpListener.GetRequestUrl(100) Then
Debug.Print "Failed to wait:"
Debug.Print httpListener.GetLastError()
Exit Do
End If
If httpListener.RequestUrl <> "" Then
Exit Do
End If
DoEvents
Loop
' Send response and stop http listener.
httpListener.SendResponse "200", "text/html; charset=utf-8", "<html><head></head><body>Please return to the app and close current window.</body></html>"
httpListener.Close
Dim requestUri
requestUri = httpListener.RequestUrl
Debug.Print "RequestUri: " & requestUri
Dim errorCode
' Checks for errors.
errorCode = ParseParameter(requestUri, "error=")
If errorCode <> "" Then
Debug.Print "OAuth authorization error: " & errorCode
Exit Sub
End If
' Check authorization code
Dim code
code = ParseParameter(requestUri, "code=")
If code = "" Then
Debug.Print "Malformed authorization response: " & requestUri
Exit Sub
End If
Debug.Print "Authorization code: " & code
Dim responseText
responseText = RequestAccessToken(code, szUri)
Debug.Print responseText
Dim parser As New EASendMailObjLib.OAuthResponseParser
parser.Load responseText
Dim user, accessToken
user = parser.EmailInIdToken
accessToken = parser.accessToken
If accessToken = "" Then
Debug.Print "Failed to request access token, return!"
Exit Sub
End If
Debug.Print "User: " & user
Debug.Print "AccessToken: " & accessToken
SendMailWithXOAUTH2 user, accessToken
End Sub
' path?parameter1=value1¶meter2=value2#anchor;
Private Function ParseParameter(ByVal uri As String, ByVal key As String) As String
ParseParameter = ""
If uri = "" Or key = "" Then
Exit Function
End If
Dim pos As Integer
pos = InStr(1, uri, "?")
If pos <= 0 Then
Exit Function
End If
uri = Mid(uri, pos + 1)
Dim i, parameters, uriParameter
parameters = Split(uri, "&")
For i = LBound(parameters) To UBound(parameters)
uriParameter = parameters(i)
If InStr(1, uriParameter, key, vbTextCompare) = 1 Then
Dim value
value = Mid(uriParameter, Len(key) + 1)
pos = InStr(1, value, "#")
If pos > 0 Then
value = Mid(value, 1, pos - 1)
End If
ParseParameter = value
Exit Function
End If
Next
End Function
Private Function RequestAccessToken(ByVal code As String, ByVal redirectUri As String) As String
Debug.Print "Exchanging code for tokens..."
RequestAccessToken = ""
Dim responseText
responseText = ""
Dim httpRequest
Set httpRequest = CreateObject("MSXML2.ServerXMLHTTP.6.0")
Dim tokenRequestBody
tokenRequestBody = "code="
tokenRequestBody = tokenRequestBody & code
tokenRequestBody = tokenRequestBody & "&redirect_uri="
tokenRequestBody = tokenRequestBody & redirectUri
tokenRequestBody = tokenRequestBody & "&client_id="
tokenRequestBody = tokenRequestBody & clientID
tokenRequestBody = tokenRequestBody & "&grant_type=authorization_code"
' If you request access token in web application, you must add client secret in token request data
' tokenRequestBody = "code="
' tokenRequestBody = tokenRequestBody & code
' tokenRequestBody = tokenRequestBody & "&redirect_uri="
' tokenRequestBody = tokenRequestBody & redirectUri
' tokenRequestBody = tokenRequestBody & "&client_id="
' tokenRequestBody = tokenRequestBody & clientID
' tokenRequestBody = tokenRequestBody & "&client_secret="
' tokenRequestBody = tokenRequestBody & clientSecret
' tokenRequestBody = tokenRequestBody & "&grant_type=authorization_code"
httpRequest.setOption 2, 13056
httpRequest.Open "POST", tokenUri, True
httpRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
httpRequest.Send tokenRequestBody
Do While httpRequest.ReadyState <> 4
DoEvents
httpRequest.waitForResponse (1)
Loop
Dim Status
Status = httpRequest.Status
responseText = httpRequest.responseText
RequestAccessToken = responseText
If Status < 200 Or Status >= 300 Then
Debug.Print "Failed to refresh access token from server."
End If
End Function
Private Sub SendMailWithXOAUTH2(ByVal userEmail As String, ByVal accessToken As String)
Dim oSmtp As New EASendMailObjLib.Mail
oSmtp.LicenseCode = "TryIt"
' Office 365 server address
oSmtp.ServerAddr = "outlook.office365.com"
' Set Exchange Web Service Protocol - EWS - Exchange 2007/2010/2013/2016/2019/Office365
oSmtp.Protocol = 1
' Enable SSL/TLS connection
oSmtp.ConnectType = ConnectSSLAuto
' OAUTH/XOAUTH2 type
oSmtp.AuthType = AuthXoauth2
' set user authentication
oSmtp.UserName = userEmail
' use access token as password
oSmtp.Password = accessToken
' Your email address
oSmtp.FromAddr = userEmail
' Please change recipient address to yours for test
oSmtp.AddRecipient "Support Team", "support@emailarchitect.net", 0
oSmtp.Subject = "Test email using Office365 Oauth"
oSmtp.BodyText = "Hello, this is a test...."
Debug.Print "start to send email using OAUTH 2.0 ..."
If oSmtp.SendMail() = 0 Then
Debug.Print "The email has been submitted to server successfully!"
Else
Debug.Print oSmtp.GetLastErrDescription()
End If
End Sub
Here is a simple application which demonstrates how to use Microsoft OAuth to do user authentication and send email with Ms Graph API protocol.
Note
This sample cannot handle the event of Web Browser is closed by user manually before authentication is completed.
You can refer to the better sample project which uses Web Browser Control
in EASendMail installation path.
Option Explicit
Const ConnectNormal = 0
Const ConnectSSLAuto = 1
Const ConnectSTARTTLS = 2
Const ConnectDirectSSL = 3
Const ConnectTryTLS = 4
Const AuthAuto = -1
Const AuthLogin = 0
Const AuthNtlm = 1
Const AuthCramMd5 = 2
Const AuthPlain = 3
Const AuthMsn = 4
Const AuthXoauth2 = 5
' client configuration
' You should create your client id and client secret,
' do not use the following client id in production environment, it is used for test purpose only.
Const clientID = "eccbabb2-3377-4265-85c1-ea2fb515f075"
Const clientSecret = "QaR_RR:-5WqTY[nni9pdBr9xVybqrAu4"
' set Ms Graph API scope
Const scope = "https://graph.microsoft.com/Mail.Send%20offline_access%20email%20openid"
Const authUri = "https://login.microsoftonline.com/common/oauth2/v2.0/authorize"
Const tokenUri = "https://login.microsoftonline.com/common/oauth2/v2.0/token"
' if your application is single tenant, please use tenant id instead of common in authUri and tokenUri
' for example, your tenant is 669595d0-a4d7-47c5-8040-cf9970400e48, then
' Const authUri = "https://login.microsoftonline.com/669595d0-a4d7-47c5-8040-cf9970400e48/oauth2/v2.0/authorize"
' Const tokenUri = "https://login.microsoftonline.com/669595d0-a4d7-47c5-8040-cf9970400e48/oauth2/v2.0/token"
Public Sub DoOauthAndSendEmail()
Dim httpListener As New EASendMailObjLib.httpListener
' Creates a redirect URI using an available port on the loopback address.
If Not httpListener.Create("127.0.0.1", 0) Then
Debug.Print "Failed to listen on " & httpListener.GetLastError()
Exit Sub
End If
Dim szUri
szUri = "http://127.0.0.1:" & httpListener.ListenPort
Debug.Print "listen on " & szUri
' Creates the OAuth 2.0 authorization request.
Dim authorizationRequest
authorizationRequest = authUri
authorizationRequest = authorizationRequest & "?response_type=code&scope="
authorizationRequest = authorizationRequest & scope
authorizationRequest = authorizationRequest & "&redirect_uri="
authorizationRequest = authorizationRequest & szUri
authorizationRequest = authorizationRequest & "&client_id="
authorizationRequest = authorizationRequest & clientID
authorizationRequest = authorizationRequest & "&prompt=login"
Debug.Print "open " & authorizationRequest
' Opens request in the browser.
Dim browserUi As New EASendMailObjLib.browserUi
browserUi.OpenUrl authorizationRequest
' Waits for the OAuth authorization response.
Do While True
If Not httpListener.GetRequestUrl(100) Then
Debug.Print "Failed to wait:"
Debug.Print httpListener.GetLastError()
Exit Do
End If
If httpListener.RequestUrl <> "" Then
Exit Do
End If
DoEvents
Loop
' Send response and stop http listener.
httpListener.SendResponse "200", "text/html; charset=utf-8", "<html><head></head><body>Please return to the app and close current window.</body></html>"
httpListener.Close
Dim requestUri
requestUri = httpListener.RequestUrl
Debug.Print "RequestUri: " & requestUri
Dim errorCode
' Checks for errors.
errorCode = ParseParameter(requestUri, "error=")
If errorCode <> "" Then
Debug.Print "OAuth authorization error: " & errorCode
Exit Sub
End If
' Check authorization code
Dim code
code = ParseParameter(requestUri, "code=")
If code = "" Then
Debug.Print "Malformed authorization response: " & requestUri
Exit Sub
End If
Debug.Print "Authorization code: " & code
Dim responseText
responseText = RequestAccessToken(code, szUri)
Debug.Print responseText
Dim parser As New EASendMailObjLib.OAuthResponseParser
parser.Load responseText
Dim user, accessToken
user = parser.EmailInIdToken
accessToken = parser.accessToken
If accessToken = "" Then
Debug.Print "Failed to request access token, return!"
Exit Sub
End If
Debug.Print "User: " & user
Debug.Print "AccessToken: " & accessToken
SendMailWithXOAUTH2 user, accessToken
End Sub
' path?parameter1=value1¶meter2=value2#anchor;
Private Function ParseParameter(ByVal uri As String, ByVal key As String) As String
ParseParameter = ""
If uri = "" Or key = "" Then
Exit Function
End If
Dim pos As Integer
pos = InStr(1, uri, "?")
If pos <= 0 Then
Exit Function
End If
uri = Mid(uri, pos + 1)
Dim i, parameters, uriParameter
parameters = Split(uri, "&")
For i = LBound(parameters) To UBound(parameters)
uriParameter = parameters(i)
If InStr(1, uriParameter, key, vbTextCompare) = 1 Then
Dim value
value = Mid(uriParameter, Len(key) + 1)
pos = InStr(1, value, "#")
If pos > 0 Then
value = Mid(value, 1, pos - 1)
End If
ParseParameter = value
Exit Function
End If
Next
End Function
Private Function RequestAccessToken(ByVal code As String, ByVal redirectUri As String) As String
Debug.Print "Exchanging code for tokens..."
RequestAccessToken = ""
Dim responseText
responseText = ""
Dim httpRequest
Set httpRequest = CreateObject("MSXML2.ServerXMLHTTP.6.0")
Dim tokenRequestBody
tokenRequestBody = "code="
tokenRequestBody = tokenRequestBody & code
tokenRequestBody = tokenRequestBody & "&redirect_uri="
tokenRequestBody = tokenRequestBody & redirectUri
tokenRequestBody = tokenRequestBody & "&client_id="
tokenRequestBody = tokenRequestBody & clientID
tokenRequestBody = tokenRequestBody & "&grant_type=authorization_code"
' If you request access token in web application, you must add client secret in token request data
' tokenRequestBody = "code="
' tokenRequestBody = tokenRequestBody & code
' tokenRequestBody = tokenRequestBody & "&redirect_uri="
' tokenRequestBody = tokenRequestBody & redirectUri
' tokenRequestBody = tokenRequestBody & "&client_id="
' tokenRequestBody = tokenRequestBody & clientID
' tokenRequestBody = tokenRequestBody & "&client_secret="
' tokenRequestBody = tokenRequestBody & clientSecret
' tokenRequestBody = tokenRequestBody & "&grant_type=authorization_code"
httpRequest.setOption 2, 13056
httpRequest.Open "POST", tokenUri, True
httpRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
httpRequest.Send tokenRequestBody
Do While httpRequest.ReadyState <> 4
DoEvents
httpRequest.waitForResponse (1)
Loop
Dim Status
Status = httpRequest.Status
responseText = httpRequest.responseText
RequestAccessToken = responseText
If Status < 200 Or Status >= 300 Then
Debug.Print "Failed to refresh access token from server."
End If
End Function
Private Sub SendMailWithXOAUTH2(ByVal userEmail As String, ByVal accessToken As String)
Dim oSmtp As New EASendMailObjLib.Mail
oSmtp.LicenseCode = "TryIt"
' Office 365 Ms Graph API server address
oSmtp.ServerAddr = "graph.microsoft.com"
' Set Office365 Ms Graph API protocol
oSmtp.Protocol = 4
' Enable SSL/TLS connection
oSmtp.ConnectType = ConnectSSLAuto
' OAUTH/XOAUTH2 type
oSmtp.AuthType = AuthXoauth2
' set user authentication
oSmtp.UserName = userEmail
' use access token as password
oSmtp.Password = accessToken
' Your email address
oSmtp.FromAddr = userEmail
' Please change recipient address to yours for test
oSmtp.AddRecipient "Support Team", "support@emailarchitect.net", 0
oSmtp.Subject = "Test email using Office365 Oauth"
oSmtp.BodyText = "Hello, this is a test...."
Debug.Print "start to send email using OAUTH 2.0 ..."
If oSmtp.SendMail() = 0 Then
Debug.Print "The email has been submitted to server successfully!"
Else
Debug.Print oSmtp.GetLastErrDescription()
End If
End Sub
If you use Microsoft OAuth in ASP application, you should use a ASP page to
get authorization code instead of HttpListener. You need to add your ASP page path
to Authentication
-> add a platform
-> web
-> Redirect URIs
in your Azure application.
' If you request access token in web application, you must add client secret in token request data
tokenRequestBody = "code="
tokenRequestBody = tokenRequestBody & code
tokenRequestBody = tokenRequestBody & "&redirect_uri="
tokenRequestBody = tokenRequestBody & redirectUri
tokenRequestBody = tokenRequestBody & "&client_id="
tokenRequestBody = tokenRequestBody & clientID
tokenRequestBody = tokenRequestBody & "&client_secret="
tokenRequestBody = tokenRequestBody & clientSecret
tokenRequestBody = tokenRequestBody & "&grant_type=authorization_code"
' Please add http://localhost/gmailoauth/default.asp to Authorized redirect URIs in your Google/MS Azure project.
Dim code
code = Request.QueryString("code")
You can find a full sample project in EASendMail installation path\Samples_ASPNetMvc
.
TLS is the successor of SSL, more and more SMTP servers require TLS 1.2
encryption now.
If your operating system is Windows XP/Vista/Windows 7/Windows 2003/2008/2008 R2/2012/2012 R2
, you need to
enable TLS 1.2 protocol in your operating system like this:
Enable TLS 1.2 on Windows XP/Vista/7/10/Windows 2008/2008 R2/2012
If you are not the tenant administrator and you don’t have the permission to create or grant the application in Azure, or if your code is too complex or out of maintenance, and you don’t want to change anything in your source codes, then you can have a try with EA Oauth Service for Offic365. It provides an easy way for the legacy email application that doesn’t support OAUTH 2.0 to send and retrieve email from Office 365 without changing any codes. SMTP, POP, IMAP and SSL/TLS protocols are supported.
Appendix
Comments
If you have any comments or questions about above example codes, please click here to add your comments.