Reading GMail email messages via VBA without Outlook - excel

How can I read GMail emails via VBA without having Outlook installed on the PC ?
I googled it but I didn't find any solution which does not relies on Outlook.

You can use the google api to archive this without outlook.
There is VBA-Web on github that supports the gmail api.
Here is an example for gmail with vba-web:
Attribute VB_Name = "Gmail"
' Setup client and authenticator (cached between requests)
Private pGmailClient As WebClient
Private Property Get GmailClient() As WebClient
If pGmailClient Is Nothing Then
' Create client with base url that is appended to all requests
Set pGmailClient = New WebClient
pGmailClient.BaseUrl = "https://www.googleapis.com/gmail/v1/"
' Use the pre-made GoogleAuthenticator found in authenticators/ folder
' - Automatically uses Google's OAuth approach including login screen
' - Get API client id and secret from https://console.developers.google.com/
' - https://github.com/timhall/Excel-REST/wiki/Google-APIs for more info
Dim Auth As New GoogleAuthenticator
Auth.Setup CStr(Credentials.Values("Google")("id")), CStr(Credentials.Values("Google")("secret"))
Auth.AddScope "https://www.googleapis.com/auth/gmail.readonly"
Auth.Login
Set pGmailClient.Authenticator = Auth
End If
Set GmailClient = pGmailClient
End Property
' Load messages for inbox
Function LoadInbox() As Collection
Set LoadInbox = New Collection
' Create inbox request with userId and querystring for inbox label
Dim Request As New WebRequest
Request.Resource = "users/{userId}/messages"
Request.AddUrlSegment "userId", "me"
Request.AddQuerystringParam "q", "label:inbox"
Dim Response As WebResponse
Set Response = GmailClient.Execute(Request)
If Response.StatusCode = WebStatusCode.Ok Then
Dim MessageInfo As Dictionary
Dim Message As Dictionary
For Each MessageInfo In Response.Data("messages")
' Load full messages for each id
Set Message = LoadMessage(MessageInfo("id"))
If Not Message Is Nothing Then
LoadInbox.Add Message
End If
Next MessageInfo
End If
End Function
' Load message details
Function LoadMessage(MessageId As String) As Dictionary
Dim Request As New WebRequest
Request.Resource = "users/{userId}/messages/{messageId}"
Request.AddUrlSegment "userId", "me"
Request.AddUrlSegment "messageId", MessageId
Dim Response As WebResponse
Set Response = GmailClient.Execute(Request)
If Response.StatusCode = WebStatusCode.Ok Then
Set LoadMessage = New Dictionary
' Pull out relevant parts of message (from, to, and subject from headers)
LoadMessage.Add "snippet", Response.Data("snippet")
Dim Header As Dictionary
For Each Header In Response.Data("payload")("headers")
Select Case Header("name")
Case "From"
LoadMessage.Add "from", Header("value")
Case "To"
LoadMessage.Add "to", Header("value")
Case "Subject"
LoadMessage.Add "subject", Header("value")
End Select
Next Header
End If
End Function
Sub Test()
Dim Message As Dictionary
For Each Message In LoadInbox
Debug.Print "From: " & Message("from") & ", Subject: " & Message("subject")
Debug.Print Message("snippet") & vbNewLine
Next Message
End Sub

You can pull GMAIL email data into Excel by adding a custom reference library EAGetMail.
You can find the install link and a demo macro here.

Related

how to take application control back from application_error

I got an old application that is using aspnet membership controls changepassword and createuserwizard etc. These send emails in the end, via gmail, after sending the email successfully, I get an application_error
The SMTP server requires a secure connection or the client was not authenticated...
The requirement is I can go back to the normal flow of application and ignore this error.
Note that the email is being sent successfully to the client. There is no exception within the procedure/catch.
Protected Sub ChangePwd_SendingMail(ByVal sender As Object, ByVal e As System.Web.UI.WebControls.MailMessageEventArgs) Handles ChangePwd.SendingMail
Dim obj As SecurePassword = New SecurePassword()
Select Case ConfigurationSettings.AppSettings("WhichSMTP")
Case "gmail"
Try
obj.SendViaGmail(e.Message.Subject, e.Message.Body, e.Message.To.ToString())
Catch ex As Exception
Response.Write("Error sending email via gmail smtp: " & ex.Message)
End Try
End Select
End Sub
SecurePassword.vb
Public Function SendViaGmail(subject As String, body As String, recipients As String)
Dim fromEmail As String = ConfigurationSettings.AppSettings("ContactEmail")
Dim smtpClient As SmtpClient = New SmtpClient("smtp.gmail.com") With {
.Port = 587,
.DeliveryMethod = SmtpDeliveryMethod.Network,
.Credentials = New NetworkCredential(fromEmail, "apppasswordgeneratedviagoogle"),
.EnableSsl = True
}
Dim mailMessage As MailMessage = New MailMessage With {
.From = New MailAddress(fromEmail),
.Subject = subject,
.Body = body,
.IsBodyHtml = True
}
mailMessage.[To].Add(recipients)
If smtpClient IsNot Nothing Then
smtpClient.Send(mailMessage)
End If
End Function
I got the above code from here
few things to note,
I am running this code from my development machine (IISExpress).
previously there was no code written under
Case "gmail"
Update:
I have tried catching it in page_error, it actually comes here but it shows me an empty page now instead of successtemplate from changepassword control
Private Sub Page_Error(sender As Object, e As EventArgs) Handles Me.Error
Dim exc As Exception = Server.GetLastError()
' Handle specific exception.
If exc.GetType = GetType(SmtpException) Then
ChangePwd.SuccessTemplate.InstantiateIn(ChangePassword)
'ChangePwd.ChangePasswordTemplateContainer.Visible = False
End If
' Clear the error from the server.
Server.ClearError()
End Sub

Alert using VBA to scan a column and send message to Telegram

I have setup remote temp readings that update in excel every second.
When the internal temp reading in Col C equals the external temp in col E, the corresponding row in col G will highlight as a match and display the property and room where the match exists.
I would like to know if it is possible for VBA code to be applied to do the following:
Scan/loop Column G and if the row is not blank to take the output and send via telegram as an alert system.
As the temperature moves a lot I would only like to be alerted once every hour but would prefer to leave the possibility of having this as a variable setting eg. every 5,10,15.20 mins linked to the excel document should I wish to change it. Any help would be most appreciated.
Any help would be most appreciated.
I have used the code so far for sending the code on telegram, my only issue is being able to create a loop on column G to find any non blank cells within a variable timeframe and linking it to send the message via telegram.
Telegram code:
Sub Main_Routine()
''' The first parameter is the recipient's number (NOT the gateway number), including the country code.
''' The second paramter is the content of the message.
TelegramMessage_Send "12025550108", "Alert message here"
End Sub
Sub TelegramMessage_Send(ByRef strNumber As String, ByRef strMessage As String)
Dim CLIENT_ID As String, CLIENT_SECRET As String, API_URL As String
Dim strJson As Variant
Dim sHTML As String
Dim oHttp As Object
''' TODO: Replace the following with your gateway instance ID, your Premium client ID and secret:
INSTANCE_ID = "YOUR_INSTANCE_ID_HERE"
CLIENT_ID = "YOUR_CLIENT_ID_HERE"
CLIENT_SECRET = "YOUR_CLIENT_SECRET_HERE"
API_URL = "http://api.whatsmate.net/v1/telegram/single/message/" & INSTANCE_ID
strJson = "{""number"": """ & strNumber & """, ""message"": """ & strMessage & """}"
Set oHttp = CreateObject("Msxml2.XMLHTTP")
oHttp.Open "POST", API_URL, False
oHttp.setRequestHeader "Content-type", "application/json"
oHttp.setRequestHeader "X-WM-CLIENT-ID", CLIENT_ID
oHttp.setRequestHeader "X-WM-CLIENT-SECRET", CLIENT_SECRET
oHttp.Send strJson
sHTML = oHttp.ResponseText
MsgBox sHTML
End Sub

Retrieving Outlook email data using Excel VBA

I am trying to grab the following details from the sent items folder with subject "Index Coverage".
Sent by
Sent to
Subject
Sent on (date)
email body
I am using formulas in the sheet with code in the ThisOutlookSession module
Index: =TRIM(MID(G2,SEARCH("Code",G2)+(8+LEN("Code")),20))
Our client: =LEFT(I2,FIND("on",I2)-1)
End client: =LEFT(K2,FIND(".",K2)-1)
Const strFilePath As String = "C:\Users\Public\Documents\Excel\OutlookMailItemsDB.xlsx"
Const strSubjectLineStartWith As String = ""
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim varArray As Variant
Dim strSub As String
Dim strBody As String
Dim strArray() As String
Dim lngLoop As Long
Dim objItem As Object
Dim lngMailCounter As Long
Dim objMItem As MailItem
strArray = Split(EntryIDCollection, ",")
For lngMailCounter = LBound(strArray) To UBound(strArray)
Set objItem = Session.GetItemFromID(strArray(lngMailCounter))
If TypeName(objItem) = "MailItem" And InStr(1, objItem.Subject, strSubjectLineStartWith) And InStr(1, objItem.Body, "") Then
Set objMItem = objItem
With CreateObject("Excel.Application").workbooks.Open(strFilePath)
With .sheets(1)
With .cells(.rows.Count, 1).End(-4162)(2).resize(1, 7)
.Value = Array(objMItem.SenderEmailAddress, objMItem.To, objMItem.CC, objMItem.BCC, objMItem.Subject, objMItem.ReceivedTime, objMItem.Body)
End With
End With
.Close 1
End With
Set objItem = Nothing
End If
Next lngMailCounter
If Not IsEmpty(strArray) Then
Erase strArray
End If
End Sub
I am able to grab:
sent by
subject
sent on
Body
Index
Our client
End client
I am not able to grab the recipient contact details.
Also the Excel sheet placed on the desktop needs to be saved and closed on its own so that next time it doesn't throw an error that Excel is not closed.
Also it should consider the sent items folder with the following subject line: "Index Coverage".
Also to grab the details for Index, Our client and End client I am using Excel formulas. Is it possible to achieve this via VBA?
First of all, creating a new Excel instance in the NewMailEx event handler each time a new email is received is not really a good idea. I'd suggest keeping a reference when the add-in works (like a singleton) to prevent any additional workload when receiving a new item.
Try to use the Recipients property of the MailItem class instead of using the To, Cc or Bcc fields. The Recipients collection returns a Recipients collection that represents all the recipients for the Outlook item. Use Recipients(index) where index is the name or index number, to return a single Recipient object. The name can be a string representing the display name, the alias, or the full SMTP email address of the recipient.
Finally, to process items added to the sent items folder you need to handle ItemAdd event which is fired when one or more items are added to the specified collection.
Public WithEvents myOlItems As Outlook.Items
Public Sub Initialize_handler()
Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentItems).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
' your code for processing the Item object goes there
End Sub

VBA-WEB unable to authorize with httpbasic authenticator

I am trying to use VBA-Web for submitting REST API via Excel VBA and running into issues
https://github.com/VBA-tools/VBA-Web
I tried to modify this example to use HttpBasicAuthenticator but unsuccessful it says HTTP error 401. When I use Postman to submit the rest request it is fine.
https://github.com/revisohq/api-samples/tree/master/rest/excel
If I use this Url that does not need to authenticate. It works as expected
https://rest.reviso.com/customers?demo=true
Private Sub Worksheet_Activate()
Dim Client As New WebClient
Dim Request As New WebRequest
Client.TimeoutMs = 30000 ' 30 seconds
Client.BaseUrl = "https://postman-echo.com/basic-auth"
'Client.BaseUrl = "https://rest.reviso.com/customers?demo=true"
Request.Format = WebFormat.Json
Dim Auth As New HttpBasicAuthenticator
Auth.Setup _
Username:="postman", _
Password:="password"
Dim Response As WebResponse
Set Response = Client.Execute(Request)
If Response.StatusCode <> Ok Then
Sheets("Test").Range("A1") = Response.StatusDescription
Exit Sub
End If
Dim Json As Object
Set Json = WebHelpers.ParseJson(Response.Content)
FillData Json
End Sub

Fetching gmail inbox mail messages via CDO in vba excel

I would like to access the inbox in a gmail account using CDO in VBA.
I have already managed to send a mail message but do not know how to fetch the inbox messages into an excel sheet.
If possible I would like to be able to identify the tags of each message as well.
While the question asks for CDO in particular, from this similar SO question it doesn't look like this is possible directly with CDO.
As an alternative approach to fetching inbox mail messages, Google has recently released a Gmail API that could be consumed with Excel. Below is an example using VBA-Web:
' Setup client and authenticator (cached between requests)
Private pGmailClient As WebClient
Private Property Get GmailClient() As WebClient
If pGmailClient Is Nothing Then
' Create client with base url that is appended to all requests
Set pGmailClient = New WebClient
pGmailClient.BaseUrl = "https://www.googleapis.com/gmail/v1/"
' Use the pre-made GoogleAuthenticator found in authenticators/ folder
' - Automatically uses Google's OAuth approach including login screen
' - Get API client id and secret from https://console.developers.google.com/
' - https://github.com/timhall/Excel-REST/wiki/Google-APIs for more info
Dim Auth As New GoogleAuthenticator
Auth.Setup "Your client id", "Your client secret"
Auth.AddScope "https://www.googleapis.com/auth/gmail.readonly"
Auth.Login
Set pGmailClient.Authenticator = Auth
End If
Set GmailClient = pGmailClient
End Property
' Load messages for inbox
Function LoadInbox() As Collection
Set LoadInbox = New Collection
' Create inbox request with userId and querystring for inbox label
Dim Request As New WebRequest
Request.Resource = "users/{userId}/messages"
Request.AddUrlSegment "userId", "me"
Request.AddQuerystringParam "q", "label:inbox"
Dim Response As WebResponse
Set Response = GmailClient.Execute(Request)
If Response.StatusCode = WebStatusCode.Ok Then
Dim MessageInfo As Dictionary
Dim Message As Dictionary
For Each MessageInfo In Response.Data("messages")
' Load full messages for each id
Set Message = LoadMessage(MessageInfo("id"))
If Not Message Is Nothing Then
LoadInbox.Add Message
End If
Next MessageInfo
End If
End Function
' Load message details
Function LoadMessage(MessageId As String) As Dictionary
Dim Request As New WebRequest
Request.Resource = "users/{userId}/messages/{messageId}"
Request.AddUrlSegment "userId", "me"
Request.AddUrlSegment "messageId", MessageId
Dim Response As WebResponse
Set Response = GmailClient.Execute(Request)
If Response.StatusCode = WebStatusCode.Ok Then
Set LoadMessage = New Dictionary
' Pull out relevant parts of message (from, to, and subject from headers)
LoadMessage.Add "snippet", Response.Data("snippet")
Dim Header As Dictionary
For Each Header In Response.Data("payload")("headers")
Select Case Header("name")
Case "From"
LoadMessage.Add "from", Header("value")
Case "To"
LoadMessage.Add "to", Header("value")
Case "Subject"
LoadMessage.Add "subject", Header("value")
End Select
Next Header
End If
End Function
Sub Test()
Dim Message As Dictionary
For Each Message In LoadInbox
Debug.Print "From: " & Message("from") & ", Subject: " & Message("subject")
Debug.Print Message("snippet") & vbNewLine
Next Message
End Sub

Resources