Outlook to Gsuite (1 Viewer)

Gismo

Registered User.
Local time
Today, 04:30
Joined
Jun 12, 2017
Messages
798
Hi,

Please assist, for some reason, VBA is not reading my recipient list.

1614660766468.png
 

Gasman

Enthusiastic Amateur
Local time
Today, 02:30
Joined
Sep 21, 2011
Messages
7,898
That would indicate that you did not have ANY email addresses?

Walk through your code line by line, especially where you get the email addresses.
 

Gismo

Registered User.
Local time
Today, 04:30
Joined
Jun 12, 2017
Messages
798
That would indicate that you did not have ANY email addresses?

Walk through your code line by line, especially where you get the email addresses.
The query that contains all the email addresses have all the info required

the issue is not with the data, I recon the VBA code is not reading the query correctly so i might have some missing data in my VBA

i was asked to post my complete code instead of sections
Here is the complete code again
Do you perhaps see the missing criteria?

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

Private Sub Excecute_Click()


Dim SQL As String
Dim WPassStr As String
Dim sSQL As String

'Enter Password
If Nz(DLookup("[WPass]", "[EmailTbl]")) = "" Then
Dim Message, Title, Default
Message = "Enter Windows Password"
Title = "Enter Parameters"
WPassStr = InputBox(Message, Title)
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE EmailTbl SET WPass =""" & WPassStr & """"
DoCmd.SetWarnings True
End If


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 EmailTBL ")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do
If Not IsNull(rs!email) Then
vRecipientList = vRecipientList & rs!To & "," 'Vlad - changed email separator to comma
rs.MoveNext
Else
rs.MoveNext
End If

Loop Until rs.EOF

vMsg = [Message]
vSubject = "New DAW Sheet Listing - Registration: " & " " & [Registration]
vReportPDF = CurrentProject.Path & "\" & "DAW Sheet"

'<<<<<<<<<<<<<<<<<<<<export the report as PDF>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
DoCmd.OutputTo acReport, "DAW Sheet", acFormatPDF, vReportPDF
'<<<<<<<<<<<<<<<<<<<<export the report as PDF>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>


'<<<<<<<<<<<<<<<<<<call Colin's sub to email report as attachment>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
SendEMailCDO vRecipientList, "", vSubject, vMsg, "", vReportPDF
'<<<<<<<<<<<<<<<<<<call Colin's sub to email report as attachment>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

'MsgBox ("Report successfully eMailed!")

Else
MsgBox "No contacts."
End If
'DoCmd.RunMacro "New DAW Email List"
End Sub

Public Function GetUserName() As String
GetUserName = Environ("UserName")
End Function

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

Dim rs As Recordset
Dim vToUser As String
Dim vProductionPlannerMail As String

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

Loop Until rs.EOF

aCC = vProductionPlannerMail
aFrom = vToUser

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




'Dim CDOEmailType As String
Dim txtSendUsing As String
Dim txtPort As String
Dim txtServer As String
Dim txtAuthenticate As String
Dim intTimeOut As String
Dim txtSSL As String
Dim txtusername As String
Dim txtPassword As String
Dim VWPass As String


Set rs = CurrentDb.OpenRecordset("SELECT * FROM EmailTBL ")
VWPass = VWPass & rs!WPass



Set rs = CurrentDb.OpenRecordset("SELECT * FROM GMailSettingsQry ")

'CDOEmailType = rs!EmailType
txtSendUsing = rs!SendUsing
txtPort = rs!ServerPort
txtServer = rs!EmailServer
txtAuthenticate = rs!SMTPAuthenticate
intTimeOut = rs!Timeout
txtusername = GetUserName
txtPassword = rs!VWPass
txtSSL = rs!UseSSL

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 If
End Sub
 

Gasman

Enthusiastic Amateur
Local time
Today, 02:30
Joined
Sep 21, 2011
Messages
7,898
Still have not learnt to indent your code I see? :(
You just make it harder for yourself, plus any others who try and help?

As I said, without walking through the code, it is hard to determine where you have gone wrong again.?

First check vRecipientList BEFORE you call SendEmailCDO
Then in SendEmailCDO check the value of aTo

Alternative uncomment those debug lines, put them BEFORE they are used for the email, putting them after is like having a chocolate fireguard, not much use. :) You need to see the values BEFORE you attempt to use them.

Your Dims are all over the place, only the last one is actually defined as a string? I'm not even sure if just Dimming at that level makes them Global?

This is all basic debugging? Look to see what the values are at relevant places. Set breakpoints all over the place if you do not want to move line by line.
 
Last edited:

bastanu

Active member
Local time
Yesterday, 18:30
Joined
Apr 13, 2010
Messages
688
@Gizmo
Initially you had your email list (of the recipients of your report) in TechPubDual, but now you are trying to get it from Emailtbl, which Set rs = CurrentDb.OpenRecordset("SELECT * FROM TechPubDual "), which one is it?
I am going over your code now, I will post an update soon.
Cheers,
Vlad
 

bastanu

Active member
Local time
Yesterday, 18:30
Joined
Apr 13, 2010
Messages
688
And here is the update code. Please review it and read the comments I added.
Code:
Option Explicit
Dim strFilename as string, strMsg As String

Private Sub Excecute_Click()
Dim SQL As String
Dim WPassStr As String
Dim sSQL As String

'Enter Password
If Nz(DLookup("[WPass]", "[EmailTbl]")) = "" Then
    Dim Message, Title, Default
    Message = "Enter Windows Password"
    Title = "Enter Parameters"
    WPassStr = InputBox(Message, Title)
    DoCmd.SetWarnings False
    DoCmd.RunSQL "UPDATE EmailTbl SET WPass =""" & WPassStr & """" 'this line will fail if Emailtbl table is                                                                         'empty, you would need to replace it with                                                                         'an "INSERT INTO" statement
    DoCmd.SetWarnings True
End If


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;") 'you had Emailtbl here in the latest version

If rs.RecordCount > 0 Then
    rs.MoveFirst
    Do
        If Not IsNull(rs!email) Then
            vRecipientList = vRecipientList & rs("To") & "," 'Vlad - changed email separator to comma   
        End If
    rs.MoveNext
    Loop Until rs.EOF

    vMsg = rs("Message") 'do you have a Message field in TechPubDual; you shouldn't as you would have to repeat             'it for every record along with the registration; these fields should be moved to a                         'different table such as Emailtbl if that has only one record for the email settings
    'vMsg= DLookup("[Message]", "[EmailTbl]") 'uncomment this line if you move the fields to Emailtbl and                         'comment or delete the one above
    vSubject = "New DAW Sheet Listing - Registration: " & " " & rs("Registration") 'see comment above       
    'vSubject ="New DAW Sheet Listing - Registration: " & " " & DLookup("[Registration]","[EmailTbl]")                  'uncomment the above line if you move the fields to Emailtbl andment or delete the original one above it

    vReportPDF = CurrentProject.Path & "\" & "DAW Sheet.pdf" 'you have to include the extension

    '<<<<<<<<<<<<<<<<<<<<export the report as PDF>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    DoCmd.OutputTo acReport, "DAW Sheet", acFormatPDF, vReportPDF
    '<<<<<<<<<<<<<<<<<<<<export the report as PDF>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>   
    '<<<<<<<<<<<<<<<<<<call Colin's sub to email report as attachment>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    SendEMailCDO vRecipientList, "", vSubject, vMsg, "", vReportPDF
    '<<<<<<<<<<<<<<<<<<call Colin's sub to email report as attachment>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

    MsgBox ("Report successfully eMailed!")

Else
    MsgBox "No contacts."
End If

End Sub

Public Function GetUserName() As String
GetUserName = Environ("UserName")
End Function

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

Dim vProductionPlannerMail As String

aCC = vProductionPlannerMail

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

'Dim CDOEmailType As String
Dim txtSendUsing As String
Dim txtPort As String
Dim txtServer As String
Dim txtAuthenticate As String
Dim intTimeOut As String
Dim txtSSL As String
Dim txtusername As String
Dim txtPassword As String
Dim VWPass As String


Set rs = CurrentDb.OpenRecordset("SELECT * FROM EmailTBL ") 'why not keep this
VWPass = VWPass & rs!WPass 'why not keep this in the same table as the other settings


Set rs = CurrentDb.OpenRecordset("SELECT * FROM GMailSettingsQry ")

'CDOEmailType = rs!EmailType
txtSendUsing = rs!SendUsing
txtPort = rs!ServerPort
txtServer = rs!EmailServer
txtAuthenticate = rs!SMTPAuthenticate
intTimeOut = rs!Timeout
txtusername = GetUserName
'<<<<<txtPassword = rs!VWPass 'VWPass is in a different table and you already got it above
txtPassword =VWPass
txtSSL = rs!UseSSL

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 If
End Sub

Cheers,
Vlad
 

bastanu

Active member
Local time
Yesterday, 18:30
Joined
Apr 13, 2010
Messages
688
I will attach the code as a text file as the forum's site messed it up.
Cheers,
Vlad
 

Attachments

  • Gizmo.txt
    6.1 KB · Views: 13

Gismo

Registered User.
Local time
Today, 04:30
Joined
Jun 12, 2017
Messages
798
@Gizmo
Initially you had your email list (of the recipients of your report) in TechPubDual, but now you are trying to get it from Emailtbl, which Set rs = CurrentDb.OpenRecordset("SELECT * FROM TechPubDual "), which one is it?
I am going over your code now, I will post an update soon.
Cheers,
Vlad
Hi,

on my first DB I linked to TechPupDual
on my last DB I link to EmailTBL

I moved a few code lines around, suppose it makes more cense

Still I ca not understand why the code works perfect in my other DB
now I made the change as per all the suggestions but still i am doing something wrong somewhere.

but now I get an error the rs requires an object

1614762747998.png
 
Last edited:

bastanu

Active member
Local time
Yesterday, 18:30
Joined
Apr 13, 2010
Messages
688
Try to remove the spaces at the end of the two Select statements. Did you read my comments regarding the various tables? You are using EmailTBL to build your list of recipients which suggests it has multiple records yet to store the Windows password, the body of the message you want to send and part of the subject line of the message in the same table, meaning you have to replicate these three fields for each record. You should move those to the GmailSettingsTbl ( I don't know why you have a GMailSettingsQry as that table shold only have one record).

Cheers,
Vlad
 

Gismo

Registered User.
Local time
Today, 04:30
Joined
Jun 12, 2017
Messages
798
Try to remove the spaces at the end of the two Select statements. Did you read my comments regarding the various tables? You are using EmailTBL to build your list of recipients which suggests it has multiple records yet to store the Windows password, the body of the message you want to send and part of the subject line of the message in the same table, meaning you have to replicate these three fields for each record. You should move those to the GmailSettingsTbl ( I don't know why you have a GMailSettingsQry as that table shold only have one record).

Cheers,
Vlad
Hi,

yes I did read your previous comment.
I am working trough it.
I am currently working on the EmailTbl. TechPubDual was for a different DB
my GmailSettingTbl only has one line, correct.
all my To and CC emails are in my EmailTBL table and I created a EmailTBLQry to be able to add in the future.
I have a GmailSettingQry as I though it would be better to read from a query than from a table.

I have removed the spaces from the select statement but still gives me a object required compile error.

1614834312240.png
 
Last edited:

bastanu

Active member
Local time
Yesterday, 18:30
Joined
Apr 13, 2010
Messages
688
Please post the entire code again, I cannot see where you declare the rs as DAO.Recordset.

Cheers,
 

Gismo

Registered User.
Local time
Today, 04:30
Joined
Jun 12, 2017
Messages
798
Please post the entire code again, I cannot see where you declare the rs as DAO.Recordset.

Cheers,
Option Explicit
Dim strFilename As String, strMsg As String

Private Sub Excecute_Click()
Dim SQL As String
Dim WPassStr As String
Dim sSQL As String

'Enter Password
If Nz(DLookup("[WPass]", "[EmailTblQry]")) = "" Then
Dim Message, Title, Default
Message = "Enter Windows Password"
Title = "Enter Parameters"
WPassStr = InputBox(Message, Title)
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE EmailTblQry SET WPass =""" & WPassStr & """"
DoCmd.SetWarnings True
End If


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 EmailTBLQry; ")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do
If Not IsNull(rs!To) Then
'vRecipientList = vRecipientList & rs!To & "," 'Vlad - changed email separator to comma
vRecipientList = vRecipientList & rs("To") & "," 'Vlad - changed email separator to comma
rs.MoveNext
Else
rs.MoveNext
End If

Loop Until rs.EOF


'vSubject = "New DAW Sheet Listing - Registration: " & " " & rs("Registration")
vSubject = "New DAW Sheet Listing - Registration: " & " " & DLookup("[Registration]", "[EmailTblQry]")
vReportPDF = CurrentProject.Path & "\" & "DAW Sheet.pdf"

'<<<<<<<<<<<<<<<<<<<<export the report as PDF>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
DoCmd.OutputTo acReport, "DAW Sheet", acFormatPDF, vReportPDF
'<<<<<<<<<<<<<<<<<<<<export the report as PDF>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>


'<<<<<<<<<<<<<<<<<<call Colin's sub to email report as attachment>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
SendEMailCDO vRecipientList, "", vSubject, vMsg, "", vReportPDF
'<<<<<<<<<<<<<<<<<<call Colin's sub to email report as attachment>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

'MsgBox ("Report successfully eMailed!")

Else
MsgBox "No contacts."
End If
'DoCmd.RunMacro "New DAW Email List"
End Sub

Public Function GetUserName() As String
GetUserName = Environ("UserName")
End Function

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

Dim vProductionPlannerMail As String
Dim rs As String
aCC = vProductionPlannerMail

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

'Dim CDOEmailType As String
Dim txtSendUsing As String
Dim txtPort As String
Dim txtServer As String
Dim txtAuthenticate As String
Dim intTimeOut As String
Dim txtSSL As String
Dim txtusername As String
Dim txtPassword As String
Dim VWPass As String

Set rs = CurrentDb.OpenRecordset("SELECT * FROM EmailTBLQry;")
VWPass = VWPass & rs!WPass

Set rs = CurrentDb.OpenRecordset("SELECT * FROM GMailSettingsQry;")

'CDOEmailType = rs!EmailType
txtSendUsing = rs!SendUsing
txtPort = rs!ServerPort
txtServer = rs!EmailServer
txtAuthenticate = rs!SMTPAuthenticate
intTimeOut = rs!Timeout
txtusername = GetUserName
'<<<<<txtPassword = rs!VWPass 'VWPass is in a different table and you already got it above
'txtPassword = VWPass
txtSSL = rs!UseSSL


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 If
End Sub
 

Gasman

Enthusiastic Amateur
Local time
Today, 02:30
Joined
Sep 21, 2011
Messages
7,898
Please post the entire code again, I cannot see where you declare the rs as DAO.Recordset.

Cheers,
That is because he has defined it as a string??????
Dim rs As String
 

Gasman

Enthusiastic Amateur
Local time
Today, 02:30
Joined
Sep 21, 2011
Messages
7,898
Hi,

Was defining as string incorrect?
What should it be defined as?
Gismo,
That question really disappoints me, and reveals a great deal. :(

I'll give you a clue.
In one portion of the code you define rs as a recordset and then use that to get data from TechPubDual
You 'say' that gets you your email addresses. ? It used to, until you posted your last update, but let's say it does anyway.

Then in Sub SendEMailCDO you define it as a string.? :unsure:

Which do you think it should be defined as? :unsure:

Google 'Access recordset' and see what a recordset actually is. The clue is in the name anyway.

You do not seem to be learning anything at all with all these mistakes, which again disappoints me. I try and learn by my mistakes and avoid repeating them. :)
 

Gismo

Registered User.
Local time
Today, 04:30
Joined
Jun 12, 2017
Messages
798
Gismo,
That question really disappoints me, and reveals a great deal. :(

I'll give you a clue.
In one portion of the code you define rs as a recordset and then use that to get data from TechPubDual
You 'say' that gets you your email addresses. ? It used to, until you posted your last update, but let's say it does anyway.

Then in Sub SendEMailCDO you define it as a string.? :unsure:

Which do you think it should be defined as? :unsure:

Google 'Access recordset' and see what a recordset actually is. The clue is in the name anyway.

You do not seem to be learning anything at all with all these mistakes, which again disappoints me. I try and learn by my mistakes and avoid repeating them. :)
Oh I see, sorry, missed that completely
changed to Recordset
that cleared the RS object required error

Thank you


I am really having a difficult time understanding and learning these complex VBA codes, well they are rather complex to me
a year ago i did not even attempt to try a VBA code.

The techPubDual is used in another DB and it has been tested and working for the past week
In another DB, the one I am currently working on, I use EmailTblQry, which it does not seem to work.

This is the actual error I was enquiring about in an earlier post, but then I incorrectly updated the incorrect RS Dim

1614850097772.png


I am still trying to understand the debugging you suggested and are working through that.
for a start, in the Immediate window, there is no result in vRecipientList that comes from my query EmailTblQry, which has the desired results when you run the query individually.
 

Gasman

Enthusiastic Amateur
Local time
Today, 02:30
Joined
Sep 21, 2011
Messages
7,898
As I said before, sit back and think of the what you are trying to do and the steps to achieve it. Break it down to small steps, make sure one works before moving on to the next. If you just throw a pile of code together, a novice cannot tell where the error is, if the debugger does not show them.

indent your code to make it easier to read AND debug errors. Google Smart Indenter and install that. I use that a lot for other peoples code (like yours :) ), so that I can read it easier.

I tend to think of 'How would I do it manually', then automate it, then perhaps tweak it.

It does not have to be the most efficient code in the world, but it does have to work reliably, time after time.

Google is your friend here. :)
 

Gismo

Registered User.
Local time
Today, 04:30
Joined
Jun 12, 2017
Messages
798
As I said before, sit back and think of the what you are trying to do and the steps to achieve it. Break it down to small steps, make sure one works before moving on to the next. If you just throw a pile of code together, a novice cannot tell where the error is, if the debugger does not show them.

indent your code to make it easier to read AND debug errors. Google Smart Indenter and install that. I use that a lot for other peoples code (like yours :) ), so that I can read it easier.

I tend to think of 'How would I do it manually', then automate it, then perhaps tweak it.

It does not have to be the most efficient code in the world, but it does have to work reliably, time after time.

Google is your friend here. :)
well i never thought that, debig.print works like a charm

thank you so much

Now just to run through the code and fine all my errors and see I it works
 

Gasman

Enthusiastic Amateur
Local time
Today, 02:30
Joined
Sep 21, 2011
Messages
7,898
well i never thought that, debig.print works like a charm

thank you so much

Now just to run through the code and fine all my errors and see I it works
Small steps @Gismo
Small steps. :)
 

bastanu

Active member
Local time
Yesterday, 18:30
Joined
Apr 13, 2010
Messages
688
Glad to hear you are making progress learning to debug your code, it is an essential skil that will greatly help you along your programming way...

I would suggest you use DAO.Recordset in your declarations to avoid ambiguity (there is another beast called ADO.Recordset and you don't want Access to get confused which one you want).

Can you please attach a copy of the EmailTBL table (or at least a screen shot)? As I explained a few times, it is not advisible to keep information that is not meant to be duplicated, such as WPassStr (the manually entered Windows password of the current user), the body of the email message and the "Registration" component of the email subject in a table that is meant as a storage for multiple recipient email addresses. You should really move those three fields to the GMailSettings table.

I noticed you also lost along the way the vMsg variable, it is not set anywhere but you do pass it to Colin's CDO function. Try to go over the code I uploaded earlier (use the text attachment as it is indented much better than the one posted with the code tags).

Cheers,
 

Users who are viewing this thread

Top Bottom