Outlook to Gsuite (1 Viewer)

Gismo

Registered User.
Local time
Today, 02:10
Joined
Jun 12, 2017
Messages
1,298
Hi All,

We have migrated from Outlook to GSuite
Some users are still using Outlook for a few months.
I now have to rebuild all my VBA codes to send to gmail

Please could you advise on how to adjust my VBA code

any chance to have the VBA code to check for GSuite users or Outlook users to have both options available se send mail?

Private Sub Command2_Click()
Dim rs As Recordset
Dim vRecipientList As String
Dim vMsg As String
Dim vSubject As String


Set rs = CurrentDb.OpenRecordset("SELECT * FROM TechPubDual ")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do
If Not IsNull(rs!email) Then
vRecipientList = vRecipientList & rs!email & ";"
rs.MoveNext
Else
rs.MoveNext
End If

Loop Until rs.EOF

vMsg = "Please find attached new document loaded"
vSubject = "New Document Loaded"

DoCmd.SendObject acSendReport, "Email SB Notification - From TechPubs - All - SB TBL", acFormatPDF, vRecipientList, , , vSubject, vMsg, False
MsgBox ("Report successfully eMailed!")

Else
MsgBox "No contacts."
End If

DoCmd.RunMacro "Save Loadlist"
End Sub
 

The_Doc_Man

Immoderate Moderator
Staff member
Local time
Yesterday, 19:10
Joined
Feb 28, 2001
Messages
27,001

That link identifies the registry key that would tell you which e-mail utility is the default. I believe there is a way to read registry key values using the GetSetting function call that you would use in that case.


Note that if someone has a machine on which both products are installed, it is theoretically possible that the user isn't using the default mail utility and in that case, you have no way (that I know of) to know which one to use. I don't know how to tell if the network port required for a given utility has been enabled AND that you are actually using it.
 

Gismo

Registered User.
Local time
Today, 02:10
Joined
Jun 12, 2017
Messages
1,298

That link identifies the registry key that would tell you which e-mail utility is the default. I believe there is a way to read registry key values using the GetSetting function call that you would use in that case.


Note that if someone has a machine on which both products are installed, it is theoretically possible that the user isn't using the default mail utility and in that case, you have no way (that I know of) to know which one to use. I don't know how to tell if the network port required for a given utility has been enabled AND that you are actually using it.
I will have a look at this, thank you
I first need to modify my code to send mail to Gmail, not sure how to accomplish this
i applied so much time to get my email list working as I wanted to using outlook now i need to evolve to Gmail email, and i am not sure hot to accomplish this or modify my existing code
please could you assist?
 

Gasman

Enthusiastic Amateur
Local time
Today, 00:10
Joined
Sep 21, 2011
Messages
14,048
Search here for CDO by isladogs
 

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 00:10
Joined
Jul 9, 2003
Messages
16,245
As Paul says, CDO should help.

I blogged about it a while ago on my website here:-


There is also a download available. If you would like a free copy, contact me and I will explain how you can get a free copy...

I must say though that it was a long time ago I wrote that, so it's not up to date, it needs reviewing.
 

Gismo

Registered User.
Local time
Today, 02:10
Joined
Jun 12, 2017
Messages
1,298
our server is blocking this contents, please could you possible send me the code?
 

Gismo

Registered User.
Local time
Today, 02:10
Joined
Jun 12, 2017
Messages
1,298
is there a simple way to change my existing code to mail directly to gmail?

Private Sub Command2_Click()
Dim rs As Recordset
Dim vRecipientList As String
Dim vMsg As String
Dim vSubject As String


Set rs = CurrentDb.OpenRecordset("SELECT * FROM TechPubDual ")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do
If Not IsNull(rs!email) Then
vRecipientList = vRecipientList & rs!email & ";"
rs.MoveNext
Else
rs.MoveNext
End If

Loop Until rs.EOF

vMsg = "Please find attached new document loaded"
vSubject = "New Document Loaded"

DoCmd.SendObject acSendReport, "Email SB Notification - From TechPubs - All - SB TBL", acFormatPDF, vRecipientList, , , vSubject, vMsg, False
MsgBox ("Report successfully eMailed!")

Else
MsgBox "No contacts."
End If

DoCmd.RunMacro "Save Loadlist"
End Sub
 

Gasman

Enthusiastic Amateur
Local time
Today, 00:10
Joined
Sep 21, 2011
Messages
14,048
our server is blocking this contents, please could you possible send me the code?
Well the CDO code has been posted here several times I believe?

Here is Colin's (isaldogs) code.
Puzzled as to why your server would block his site? :(
 

Attachments

  • CDO EMail Tester v1908.zip
    393.7 KB · Views: 399

Gismo

Registered User.
Local time
Today, 02:10
Joined
Jun 12, 2017
Messages
1,298
Search here for CDO by isladogs
by using CDO, how will it work? if I have an attachment to send, will access open my gmail and attach the document to a new email?
 

Gismo

Registered User.
Local time
Today, 02:10
Joined
Jun 12, 2017
Messages
1,298
Well the CDO code has been posted here several times I believe?

Here is Colin's (isaldogs) code.
Puzzled as to why your server would block his site? :(
there is quite a few website they have blocked, not sure why but yeh.

thank you, will have a look at the attachment
 

Gasman

Enthusiastic Amateur
Local time
Today, 00:10
Joined
Sep 21, 2011
Messages
14,048
by using CDO, how will it work? if I have an attachment to send, will access open my gmail and attach the document to a new email?
No idea, never used it.
 

The_Doc_Man

Immoderate Moderator
Staff member
Local time
Yesterday, 19:10
Joined
Feb 28, 2001
Messages
27,001
The concepts of CDO are similar but not identical to the way that Outlook works. Outlook has a really complex infrastructure because it allows you to interact with mail, tasks, schedules, contact lists, and a small list of other features. CDO is mail-only so far as I recall. To use it, you have to first configure it by identifying things you will use. For example, you can choose to exercise a TLS option for transmission security. Once you have the CDO nucleus configured, you can then implement attachments. Note, however, that you cannot easily implement message encryption in the same style as Outlook. TLS transmission is about the farthest I've ever seen along those lines. Maybe some of these links will make it through your firewalls. I would think that at least the stuff in the Microsoft.COM tree ought to be accepted.





 

bastanu

AWF VIP
Local time
Yesterday, 17:10
Joined
Apr 13, 2010
Messages
1,401
If you are using Docmd.SendObject chances are it will still work in Gmail but you will need to change the email address separator when you concatenate your lists from semi-colon (only used by Outlook) to comma (used by most other email clients). For the Outlook users they will need to go in File\Options\Mail and under Send Mail check the box to allow commas as separator:
Capture.PNG
 

Pat Hartman

Super Moderator
Staff member
Local time
Yesterday, 20:10
Joined
Feb 19, 2002
Messages
42,981
Just FYI, when the product is "free", YOU are the product so Google is making their money by selling your information.
 

Gismo

Registered User.
Local time
Today, 02:10
Joined
Jun 12, 2017
Messages
1,298
Hi,

i am getting myself into something that I am not very familiar with
setting up email using outlook was a challenge but I got it working
now we have implemented GSuite with my drive google drive management
i just found out that they use SSO configuration, what that means i am not sure but will CDO be compatible with this?

thank you for all the info you have supplied thus far, i will most definitely work with it.
 

The_Doc_Man

Immoderate Moderator
Staff member
Local time
Yesterday, 19:10
Joined
Feb 28, 2001
Messages
27,001
SSO is essentially saying you sign on to your session and those sign-in credentials will be applied to everything else you do, implicitly or explicitly. CDO works in that environment. When I was still a Navy contractor, we had SSO in place. CDO, because it is a package compatible with something that doesn't REQUIRE a separate sign-in (MS Office), doesn't interact with the sign-in. Outlook is capable of this sign-in for encryption, but CDO does not try that style of encryption so isn't going to trip over it.

GSuite is one for which I have no expertise; therefore I have no idea whether IT will require anything special in an SSO environment. For that narrow question, I defer to my colleagues.
 

bastanu

AWF VIP
Local time
Yesterday, 17:10
Joined
Apr 13, 2010
Messages
1,401
Not sure what is happening to this thread but your latest post doesn't show up.

Have you tried your existing code with just changing ";" to "," on this line:
vRecipientList = vRecipientList & rs!email & ","

Try to run it on a computer with GSuite (making sure Gmail is set as the default email client) and see what's happening.

If you want to try CDO this should get you almost there, in Colin's function you will need to update all the required authentication fields:
Code:
Sub emailReportAsPDF()
Dim rs As Recordset
Dim vRecipientList As String
Dim vMsg As String
Dim vSubject As String
Dim vReportPDF as String

Set rs = CurrentDb.OpenRecordset("SELECT * FROM TechPubDual ")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do
If Not IsNull(rs!email) Then
vRecipientList = vRecipientList & rs!email & "," 'Vlad - changed email separator to comma
rs.MoveNext
Else
rs.MoveNext
End If

Loop Until rs.EOF

vMsg = "Please find attached new document loaded"
vSubject = "New Document Loaded"
vReportPDF = CurrentProject.Path & "\" & "Email_SB_Notification_From_TechPubs_All_SB_TBL.pdf"
Docmd.OutputTo acReport,"Email SB Notification - From TechPubs - All - SB TBL",acFormatPDF, vReportPDF

'DoCmd.SendObject acSendReport, "Email SB Notification - From TechPubs - All - SB TBL", acFormatPDF, vRecipientList, , , vSubject, vMsg, False
SendEMailCDO vRecipientList,"",vSubject,vMsg,"",vReportPDF

MsgBox ("Report successfully eMailed!")

Else
MsgBox "No contacts."
End If


Sub SendEMailCDO(aTo, aCC, aSubject, aTextBody, aFrom, aPath)

'==========================================
'Original code by Jeff Blumson
'Adapted by Colin Riddington to include file attachments
'Date: 25/08/2007
'==========================================

On Error GoTo err_SendEMailCDO

Const CdoBodyFormatText = 1
Const CdoBodyFormatHTML = 0
Const CdoMailFormatMime = 0
Const CdoMailFormatText = 1

Dim Message As Object
'Create CDO message object
Set Message = CreateObject("cdo.Message")
With Message.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = txtSendUsing
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = txtPort
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = txtServer
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = txtAuthenticate
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = txtUserName
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = txtPassword
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = intTimeout
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = txtSSL
   
    'code for STARTTLS
    If txtPort = 587 Then
        .Item("http://schemas.microsoft.com/cdo/configuration/sendtls").Value = True
    End If
    .Update
   
End With

DoCmd.Hourglass True

With Message
        .To = aTo                                   'Set email adress
        .Subject = aSubject                         'Set subject
        .TextBody = aTextBody                       'Set body text
        If Len(aCC) > 0 Then .CC = aCC              'Set copy to
        If Len(aFrom) > 0 Then .From = aFrom        'Set sender address if specified.
        If Len(aPath) > 0 Then .AddAttachment (aPath) 'Attach this file
        .Send    'Send the message
End With

'Debug lines
    'Debug.Print txtSendUsing, txtPort, txtAuthenticate, intTimeout
    'Debug.Print txtServer, txtUserName, txtPassword
    'Debug.Print aTo, aCC, aFrom
    'Debug.Print aSubject
    'Debug.Print aTextBody
    'Debug.Print aPath
   
DoCmd.Hourglass False

'Show message
MsgBox "The email message has been sent successfully.  ", vbInformation, "EMail message"

'Clean up
Set Message = Nothing

Exit_SendEMailCDO:
    Exit Sub

err_SendEMailCDO:
'MsgBox "Error # " & str(err.Number) & Chr(13) & err.Description

strMsg = "Sorry - I was unable to send the email message(s).   " & vbNewLine & vbNewLine & _
    "Error # " & str(Err.Number) & Chr(13) & Err.Description

MsgBox strMsg, vbCritical, "EMail message"

strMsg = ""

Resume Exit_SendEMailCDO

End Sub
Cheers,
Vlad
 

Gismo

Registered User.
Local time
Today, 02:10
Joined
Jun 12, 2017
Messages
1,298
Not sure what is happening to this thread but your latest post doesn't show up.

Have you tried your existing code with just changing ";" to "," on this line:
vRecipientList = vRecipientList & rs!email & ","

Try to run it on a computer with GSuite (making sure Gmail is set as the default email client) and see what's happening.

If you want to try CDO this should get you almost there, in Colin's function you will need to update all the required authentication fields:
Code:
Sub emailReportAsPDF()
Dim rs As Recordset
Dim vRecipientList As String
Dim vMsg As String
Dim vSubject As String
Dim vReportPDF as String

Set rs = CurrentDb.OpenRecordset("SELECT * FROM TechPubDual ")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do
If Not IsNull(rs!email) Then
vRecipientList = vRecipientList & rs!email & "," 'Vlad - changed email separator to comma
rs.MoveNext
Else
rs.MoveNext
End If

Loop Until rs.EOF

vMsg = "Please find attached new document loaded"
vSubject = "New Document Loaded"
vReportPDF = CurrentProject.Path & "\" & "Email_SB_Notification_From_TechPubs_All_SB_TBL.pdf"
Docmd.OutputTo acReport,"Email SB Notification - From TechPubs - All - SB TBL",acFormatPDF, vReportPDF

'DoCmd.SendObject acSendReport, "Email SB Notification - From TechPubs - All - SB TBL", acFormatPDF, vRecipientList, , , vSubject, vMsg, False
SendEMailCDO vRecipientList,"",vSubject,vMsg,"",vReportPDF

MsgBox ("Report successfully eMailed!")

Else
MsgBox "No contacts."
End If


Sub SendEMailCDO(aTo, aCC, aSubject, aTextBody, aFrom, aPath)

'==========================================
'Original code by Jeff Blumson
'Adapted by Colin Riddington to include file attachments
'Date: 25/08/2007
'==========================================

On Error GoTo err_SendEMailCDO

Const CdoBodyFormatText = 1
Const CdoBodyFormatHTML = 0
Const CdoMailFormatMime = 0
Const CdoMailFormatText = 1

Dim Message As Object
'Create CDO message object
Set Message = CreateObject("cdo.Message")
With Message.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = txtSendUsing
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = txtPort
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = txtServer
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = txtAuthenticate
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = txtUserName
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = txtPassword
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = intTimeout
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = txtSSL
  
    'code for STARTTLS
    If txtPort = 587 Then
        .Item("http://schemas.microsoft.com/cdo/configuration/sendtls").Value = True
    End If
    .Update
  
End With

DoCmd.Hourglass True

With Message
        .To = aTo                                   'Set email adress
        .Subject = aSubject                         'Set subject
        .TextBody = aTextBody                       'Set body text
        If Len(aCC) > 0 Then .CC = aCC              'Set copy to
        If Len(aFrom) > 0 Then .From = aFrom        'Set sender address if specified.
        If Len(aPath) > 0 Then .AddAttachment (aPath) 'Attach this file
        .Send    'Send the message
End With

'Debug lines
    'Debug.Print txtSendUsing, txtPort, txtAuthenticate, intTimeout
    'Debug.Print txtServer, txtUserName, txtPassword
    'Debug.Print aTo, aCC, aFrom
    'Debug.Print aSubject
    'Debug.Print aTextBody
    'Debug.Print aPath
  
DoCmd.Hourglass False

'Show message
MsgBox "The email message has been sent successfully.  ", vbInformation, "EMail message"

'Clean up
Set Message = Nothing

Exit_SendEMailCDO:
    Exit Sub

err_SendEMailCDO:
'MsgBox "Error # " & str(err.Number) & Chr(13) & err.Description

strMsg = "Sorry - I was unable to send the email message(s).   " & vbNewLine & vbNewLine & _
    "Error # " & str(Err.Number) & Chr(13) & Err.Description

MsgBox strMsg, vbCritical, "EMail message"

strMsg = ""

Resume Exit_SendEMailCDO

End Sub
Cheers,
Vlad
Hi,

looks good, testing it right now, but now where the Sub emailReportAsPDF() sub routine is called so the PDF attachment does not run
This is actually there my problem is, I am not sure how to call the sub routing
 

isladogs

MVP / VIP
Local time
Today, 00:10
Joined
Jan 14, 2017
Messages
18,186
@Gismo
Have you tried my CDO EMail Tester app yet? Two points
1. You do NOT need to use any additional reference libraries such as those mentioned in post #12. All the functionality needed has been built into Access for at least 15 years
2. It works with the additional security involved with GMail provided you follow the steps outlined on the final page of the Help file supplied with the app
 

Gismo

Registered User.
Local time
Today, 02:10
Joined
Jun 12, 2017
Messages
1,298
@Gismo
Have you tried my CDO EMail Tester app yet? Two points
1. You do NOT need to use any additional reference libraries such as those mentioned in post #12. All the functionality needed has been built into Access for at least 15 years
2. It works with the additional security involved with GMail provided you follow the steps outlined on the final page of the Help file supplied with the app
Hi,

yes I have, it works
but i need to attach a report from Access, not a file that was saved
that is what I am trying to do
i need to get my recipients from my qry and the report from access

not sure how to include it in the VBA code of the CDO email tester

below is the code i need to add


Option Compare Database
Option Explicit
Dim aTo, aCC, aFrom, aPath, FileList, aTextBody, aSubject, strFilename, strMsg As String
Dim aHTMLBody As String


Private Sub Submit_Click()
On Error GoTo Err_btnEmail_Click

Select Case Me.cboEMailType

Case 1 'plain text
SendEMail

Case 2 'HTML
SendHTMLEMail

End Select

Exit_btnEmail_Click:
Exit Sub

Err_btnEmail_Click:
MsgBox Err.Description
Resume Exit_btnEmail_Click
End Sub




Sub SendEMail()

aTo = txtTo 'recipient address
aCC = CurrentUserMail
aFrom = TxtFrom 'sender address
aSubject = "New Document Loaded"
aPath = TXTFilename



SendEMailCDO aTo, aCC, aSubject, aTextBody, aFrom, aPath
End Sub
Sub SendHTMLEMail()


aTo = txtTo 'recipient address
aCC = CurrentUserMail
aFrom = TxtFrom 'sender address
aPath = TXTFilename

Dim strImage As String, strSource As String
'inline image for HTML email
'strImage = " <P><IMG border=0 hspace=0 alt='' src='file://G:/Programs/MendipDataSystems/CommonFiles/SDA/Images/MDSBanner.png' align=baseline></P>"
'use forward slashes for file path and enclose in single quotes
strSource = "'file://" & Replace(CurrentDBDir(), "\", "/") & "MDSBanner.png'"
strImage = " <P><IMG border=0 hspace=0 alt='' src=" & strSource & " align=baseline></P>"

'check image exists in this folder
If Dir(CurrentDBDir & "MDSBanner.png") = "" Then
MsgBox "The sample image file 'MDSBanner.png' cannot be found" & vbCrLf & "This routine will now close"
Exit Sub
End If



SendHTMLEMailCDO aTo, aCC, aSubject, aHTMLBody, aFrom, aPath

End Sub

Sub SendEMailCDO(aTo, aCC, aSubject, aTextBody, aFrom, aPath)



On Error GoTo err_SendEMailCDO

Const CdoBodyFormatText = 1
Const CdoBodyFormatHTML = 0
Const CdoMailFormatMime = 0
Const CdoMailFormatText = 1

Dim Message As Object
'Create CDO message object
Set Message = CreateObject("cdo.Message")
With Message.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = txtSendUsing
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = txtPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = txtServer
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = txtAuthenticate
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = txtusername
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = txtPassword
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = intTimeOut
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = txtSSL

'code for STARTTLS
If txtPort = 587 Then
.Item("http://schemas.microsoft.com/cdo/configuration/sendtls").Value = True
End If
.Update

End With

DoCmd.Hourglass True

With Message
.To = aTo 'Set email adress
.Subject = aSubject 'Set subject
.TextBody = aTextBody 'Set body text
If Len(aCC) > 0 Then .CC = aCC 'Set copy to
If Len(aFrom) > 0 Then .From = aFrom 'Set sender address if specified.
.Send 'Send the message
End With

'Debug lines
'Debug.Print txtSendUsing, txtPort, txtAuthenticate, intTimeout
'Debug.Print txtServer, txtUserName, txtPassword
'Debug.Print aTo, aCC, aFrom
'Debug.Print aSubject
'Debug.Print aTextBody
'Debug.Print aPath


DoCmd.Hourglass False

'Show message
MsgBox "The email message has been sent successfully. ", vbInformation, "EMail message"

'Clean up
Set Message = Nothing

Exit_SendEMailCDO:
Exit Sub

err_SendEMailCDO:
'MsgBox "Error # " & str(err.Number) & Chr(13) & err.Description

strMsg = "Sorry - I was unable to send the email message(s). " & vbNewLine & vbNewLine & _
"Error # " & Str(Err.Number) & Chr(13) & Err.Description

MsgBox strMsg, vbCritical, "EMail message"

strMsg = "Please find attached new document loaded"

Resume Exit_SendEMailCDO

End Sub

Sub emailReportAsPDF()
Dim rs As Recordset
Dim vRecipientList As String
Dim vMsg As String
Dim vSubject As String
Dim vReportPDF As String

Set rs = CurrentDb.OpenRecordset("SELECT * FROM TechPubDual ")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do
If Not IsNull(rs!email) Then
vRecipientList = vRecipientList & rs!email & "," 'Vlad - changed email separator to comma
rs.MoveNext
Else
rs.MoveNext
End If

Loop Until rs.EOF

vMsg = "Please find attached new document loaded"
vSubject = "New Document Loaded"
vReportPDF = CurrentProject.Path & "\" & "Email_SB_Notification_From_TechPubs_All_SB_TBL.pdf"
DoCmd.OutputTo acReport, "Email SB Notification - From TechPubs - All - SB TBL", acFormatPDF, vReportPDF

'DoCmd.SendObject acSendReport, "Email SB Notification - From TechPubs - All - SB TBL", acFormatPDF, vRecipientList, , , vSubject, vMsg, False
'SendEMailCDO vRecipientList, "", vSubject, vMsg, "", vReportPDF

MsgBox ("Report successfully eMailed!")

Else
MsgBox "No contacts."
End If
End Sub
 
Last edited:

Users who are viewing this thread

Top Bottom