Solved

VBA for Gmail

Posted on 2013-06-13
9
119 Views
Last Modified: 2016-07-03
I have to convert code that sends a saved Access report PDF as an Outlook attachment to work with Gmail instead of Outlook.  Does Gmail have an object model that can be manipulated using VBA?
0
Comment
Question by:Helen_Feddema
  • 5
  • 3
9 Comments
 
LVL 27

Expert Comment

by:MacroShadow
ID: 39246148
0
 
LVL 27

Expert Comment

by:MacroShadow
ID: 39246206
0
 
LVL 31

Author Comment

by:Helen_Feddema
ID: 39249260
The first two links deal with CDO mostly for sending stuff from Excel.  They don't mention Gmail.  The third shows how to connect to a Gmail account, but it doesn't describe how to create an email, fill its To and Subject properties (or whatever the equivalents are for Gmail), attach a file to it and send it.  I think I will have to do all of this in Gmail, if that is possible.  Here is the Access VBA code (following other code that creates filtered recordsets and saves reports based on them to PDF files):

strTo = Nz(rstAccounts![RSM email])
strCC = Nz(rstAccounts![Business Manager email])
         
If strTo <> "" Then
   Set msg = appOutlook.CreateItem(olMailItem)
   msg.To = strTo
   msg.CC = strCC
   msg.Subject = rstAccounts![ACCT NAME] & " XYZ reports"
   msg.Body = "Here are the XYZ statements for " & rstAccounts![ACCT NAME] _
      & " for the past quarter"
   msg.Attachments.Add strStatementFile
   msg.Attachments.Add strScheduleFile
   msg.Attachments.Add strRPTdetailFile
   msg.Send
End If

Open in new window

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 27

Accepted Solution

by:
MacroShadow earned 500 total points
ID: 39250524
Here is a sample from one of my past projects:

Option Compare Database
Option Explicit

Private Const URL_CDOCONFIG As String = "http://schemas.microsoft.com/cdo/configuration/"

'Private Const cdoDSNDefault = 0              'None
'Private Const cdoDSNNever = 1                'None
'Private Const cdoDSNFailure = 2              'Failure
'Private Const cdoDSNSuccess = 4              'Success
'Private Const cdoDSNDelay = 8                'Delay
'Private Const cdoDSNSuccessFailOrDelay = 14  'Success, failure or delay

Public Function SendEmail(ByVal strTo As String, _
                          ByVal strFrom As String, _
                          Optional ByVal strCC As String, _
                          Optional ByVal strBCC As String, _
                          Optional ByVal strSubject As String, _
                          Optional ByVal strBody As String, _
                          Optional ByVal strServer As String, _
                          Optional ByVal intPort As Integer, _
                          Optional ByVal strUsername As String, _
                          Optional ByVal strPassword As String, _
                          Optional ByVal intSendUsing As Integer, _
                          Optional ByVal intAuthenticate As Integer, _
                          Optional ByVal blnUseSSL As Boolean, _
                          Optional ByVal intTimeout As Integer, _
                          Optional ByVal strAttachment As String) _
                          As Boolean

    On Error Resume Next
    Err.Clear
    
    ' Get settings from table
    strSubject = DLookup("sSubject", "tblSettings")
    strBody = DLookup("sBody", "tblSettings")
    strServer = DLookup("sServer", "tblSettings") 'smtp.gmail.com
    intPort = DLookup("iPort", "tblSettings") '465
    strUsername = DLookup("sUsername", "tblSettings")
    strPassword = DLookup("sPassword", "tblSettings")
    intSendUsing = DLookup("iSendUsing", "tblSettings") '2
    intAuthenticate = DLookup("iAuthenticate", "tblSettings") '1
    blnUseSSL = DLookup("bUseSSL", "tblSettings") 'True
    intTimeout = DLookup("iTimeout", "tblSettings") '10
    strFrom = strUsername

    Dim strReport As String
    Dim cdoMsg As CDO.Message
    Set cdoMsg = CreateObject("CDO.message")
    If Err Then
        Debug.Print Err.Description
        SendEmail = False
    Else
        With cdoMsg
            With .Configuration.Fields

                'Specifies the method used to send messages:
                '(1) Local SMTP Pickup Service (2) Use SMTP Over Network (3) Use Exchange Server
                .Item(URL_CDOCONFIG & "sendusing") = intSendUsing

                'The name (DNS) or IP address of the machine hosting the
                'SMTP service through which messages are to be sent.
                .Item(URL_CDOCONFIG & "smtpserver") = strServer

                'The SMTP Port which must be enabled in your network by ISP or local Firewall
                .Item(URL_CDOCONFIG & "smptserverport") = intPort

                'Specifies the authentication mechanism to use
                'when authentication is required to send messages
                'to an SMTP service using a TCP/IP network socket:
                '(1) None (2) Basic (Base64 encoded) (3) NTLM
                .Item(URL_CDOCONFIG & "smtpauthenticate") = intAuthenticate

                'Indicates whether Secure Sockets Layer (SSL) should be used when
                'sending messages using the SMTP protocol over the network or not.
                'SSL/STARTTLS: Boolean
                .Item(URL_CDOCONFIG & "smtpusessl") = blnUseSSL

                'Maximum Time in Seconds CDO will try to Establish Connection
                .Item(URL_CDOCONFIG & "smtpconnectiontimeout") = intTimeout

                'Sender's Mail ID
                .Item(URL_CDOCONFIG & "sendusername") = strUsername

                'Sender's Password
                .Item(URL_CDOCONFIG & "sendpassword") = strPassword

                'Update Configuration Entries
                .Update

            End With
            .To = strTo
            .From = strUsername
            .CC = strCC
            .BCC = strBCC
            .Sender = "You" ' Must only be English characters
            .Subject = strSubject
            .TextBody = strBody
            If Len(strAttachment) > 0 Then
                .AddAttachment strAttachment
            End If
            If Err Then
                Debug.Print Err.Description
                SendEmail = False
            Else
                DoCmd.Hourglass True
' Only supported in gmail business accounts (and several other email providers)
'                .Fields("urn:schemas:mailheader:disposition-notification-to") = strUsername
'                .Fields("urn:schemas:mailheader:return-receipt-to") = strUsername
'                .DSNOptions = cdoDSNSuccess    'Request a reciept upon opening the message, see the constants above
'                ' Set importance or Priority to high : 0=Low, 1=Normal, 2=High
'                .Fields("urn:schemas:httpmail:importance") = 1
'                .Fields("urn:schemas:mailheader:X-Priority") = 1
'                .Fields.Update
                .Send
                DoCmd.Hourglass False
                If Err Then
                    Debug.Print Err.Description
                    SendEmail = False
                Else
                    SendEmail = True
                End If
            End If
        End With

'        'Report Details
'        strReport = "SMTP Server: " & strServer & vbLf
'        strReport = strReport & "Sender: " & strUsername & vbLf
'        strReport = strReport & "Recipient: " & strTo & vbLf
'        strReport = strReport & "Server Port: " & intPort & vbLf
'        strReport = strReport & "SSL Used: " & blnUseSSL & vbLf
'        strReport = strReport & "Authentication Type: " & intAuthenticate & vbLf
'        strReport = strReport & "SMTP Service Type: " & intSendUsing & vbLf & vbLf
'        strReport = strReport & "Subject: " & strSubject & vbLf & vbLf
'        strReport = strReport & "Body: " & strBody
'
'        Debug.Print strReport

    End If

End Function

Open in new window

0
 
LVL 31

Author Comment

by:Helen_Feddema
ID: 39262940
I won't be able to do any testing for a while, because the project has been put on hold, and I don't have a Gmail account.  Thanks for the code.
0
 
LVL 27

Expert Comment

by:MacroShadow
ID: 41689196
The answer ID: 39250524 is true and tried, I hardly think that "the OP no longer requires the answer" is a reason to delete it.
0
 
LVL 31

Author Closing Comment

by:Helen_Feddema
ID: 41689219
Will give marks because I might find a use for this solution in future, though it turned out that the project went in another direction and didn't need Gmail support.
0
 
LVL 27

Expert Comment

by:MacroShadow
ID: 41689223
Thanks ;-)
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Email signatures have numerous marketing benefits. Here are 8 top reasons to turn your email signature into a marketing channel.
Are you irritated by repeating emails issue in Microsoft Outlook 2016 after recent update ?  Lets’ see how to resolve and prevent duplicate emails in the Outlook 2016 using some simple techniques.
This Micro Tutorial will demonstrate using Google Doc how to import live data to another spreadsheet in Google Spreadsheets using the IMPORTRANGE function.
This Micro Tutorial will demonstrate Google Calendar to monitor updates with top sites, such as Facebook, Google, Twitter, etc. with Marketing News. Each update of Google Calendar can be monitored, correlate dips and spikes in your website traffic, …

733 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question