UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Sending Email To Rs List, Access 2013    
 
   
brunomac
post Mar 21 2019, 09:50 AM
Post#1



Posts: 9
Joined: 21-March 19



I am trying to send an email to a list that is built by opening a record set.

When the returned query shows more than 2 records the code works; when the query returns only 1 record it is returning a too few parameters error.

The query returns a list containing just one field - [Email Address] - as email@address.com - here is the code I am using.

Anything jumping off the page as to why it doesn't work when just one record is returned?

CODE
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
    Dim emailTo As String
    Dim emailSubject As String
    Dim eBody As String

    Dim outApp As Outlook.Application
    Dim outMail As Outlook.MailItem
    Dim outlookStarted As Boolean
    
    Const olMailItem = 0
    Const olImportanceHigh = 2
    Const olFormatHTML = 2
    
    On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If outApp Is Nothing Then
        Set outApp = CreateObject("Outlook.Application")
        outlookStarted = True
    End If

    Dim qd As QueryDef

    Set qd = CurrentDb.QueryDefs("Q_PTP_UpdateNotice_DEFS")

    qd.SQL = "SELECT [E-mail Address] FROM [Q_PTP_UpdateNotice] WHERE ptpdocID =" & TempVars("ptpDocnum") & ""
    
    Set db = CurrentDb
    
    Set rs = db.OpenRecordset("Q_PTP_UpdateNotice_DEFS")

    rs.MoveFirst

    Do While Not rs.EOF
    
        emailTo = emailTo & rs![E-mail Address] & ";"
      
        rs.MoveNext
    
    Loop
    
        emailSubject = "A new comment has been added"

            eBody = "<html><body style='font-family: Arial;'><b>" & "THIS IS AN AUTOMATED NOTIFICATION." & "</b><br/><br/>" & vbCr & vbCr
            eBody = eBody & "Your Request was updated with a new comment." & "<br/><br/>" & vbCr & vbCr
            eBody = eBody & "This is auto-generated do not reply!</body></html>"
            
        Set outMail = outApp.CreateItem(olMailItem)
        outMail.BodyFormat = olFormatHTML
        outMail.To = emailTo
        outMail.Subject = emailSubject
        outMail.HTMLBody = eBody
        outMail.Send
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    
    If outlookStarted Then
        outApp.Quit
    End If
    
    Set outMail = Nothing
    Set outApp = Nothing
Go to the top of the page
 
cheekybuddha
post Mar 21 2019, 10:11 AM
Post#2


UtterAccess VIP
Posts: 11,329
Joined: 6-December 03
From: Telegraph Hill


Nothing jumps out obviously.

It might not like the trailing semi-colon with just a single address.

As a test, try:
CODE
' ...
    Do While Not rs.EOF
    
        emailTo = emailTo & ";" & rs![E-mail Address]
      
        rs.MoveNext
    
    Loop
    emailTo = Mid(emailTo, 2) ' trim initial semi-colon
' ...


Otherwise, is it possible that any rs![E-mail Address] are Null?

hth,

d

--------------------


Regards,

David Marten
Go to the top of the page
 
MadPiet
post Mar 21 2019, 10:14 AM
Post#3



Posts: 3,136
Joined: 27-February 09



Oh, where to begin?

I think you're making this a whole lot harder than it should be.

why not create a new message, and then loop through your recipients (from the recordset) and add them to the recipients collection?

something like
set rsRecipients = qdf.OpenRecordset
do while not rsRecipients.eof
olkMsg.Recipients.Add(rs.Fields("EMailAddress")
rsRecipients.MoveNext
loop

olkMsg.Send
Go to the top of the page
 
brunomac
post Mar 21 2019, 10:36 AM
Post#4



Posts: 9
Joined: 21-March 19



I thought that was a possibility, I tried to check for that as such

CODE
If rs.recordcount < 1 Then

   emailTo = rs![E-mail Address]

Else

  emailTo = emailTo & rs![E-mail Address] & ";"

End If


Still get the error when just one record is returned.

.... and no nulls, when viewing the Defs query it is in fact returning a valid record.
This post has been edited by brunomac: Mar 21 2019, 10:39 AM
Go to the top of the page
 
MadPiet
post Mar 21 2019, 11:26 AM
Post#5



Posts: 3,136
Joined: 27-February 09



If you use

Do Until rs.EOF
'add recipients
olkMsg.Recipients.Add(rs.Fields("EMailAddress"))
rs.MoveNext
Loop

then if there are no recipients or only one, it will add that one. No need to deal with the semi-colons etc.
Go to the top of the page
 
cheekybuddha
post Mar 21 2019, 12:01 PM
Post#6


UtterAccess VIP
Posts: 11,329
Joined: 6-December 03
From: Telegraph Hill


Your logic is wrong!

If rs.recordcount < 1 Then

perhaps should be:

If rs.recordcount <= 1 Then


But give Piet's suggestion a try first.

hth,

d

--------------------


Regards,

David Marten
Go to the top of the page
 
brunomac
post Mar 21 2019, 12:41 PM
Post#7



Posts: 9
Joined: 21-March 19



Correct cheekybuddha, I tried that.

I gave piets code a try, oddly with the same results - it added all email addresses from the record set if there were more than 1, but if its just 1 record it returns the too few parameters error. Really why I want to find out whats going on with my code vs trying something entirely different.

Typically that error has meant that the field name is incorrect, but I know its right and it works perfectly when the recordset has more than 1 row.

The qd returns just one field [E-mail Address] that shows as name@address.com - beating me up really good right now. Not one to give up, but might save me some time to find some ready made code vs winging it.


Go to the top of the page
 
ADezii
post Mar 21 2019, 12:56 PM
Post#8



Posts: 2,399
Joined: 4-February 07
From: USA, Florida, Delray Beach


I replaced the Temvars Variable with a Literal Value, made a couple of simple changes to the Code, and added the Importance Value. The following seems to work quite well:
CODE
Dim db As DAO.Database
Dim qd As DAO.QueryDef
Dim rs As DAO.Recordset
Dim emailTo As String
Dim emailSubject As String
Dim eBody As String
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim outlookStarted As Boolean
    
Const olMailItem = 0
Const olImportanceHigh = 2
Const olFormatHTML = 2
    
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outApp Is Nothing Then
  Set outApp = CreateObject("Outlook.Application")
    outlookStarted = True
End If

Set qd = CurrentDb.QueryDefs("Q_PTP_UpdateNotice_DEFS")
    qd.SQL = "SELECT [E-Mail Address] FROM [Q_PTP_UpdateNotice] WHERE ptpdocID = 99"
    
Set db = CurrentDb
Set rs = db.OpenRecordset("Q_PTP_UpdateNotice_DEFS")

rs.MoveFirst

Do While Not rs.EOF
  If Not IsNull(rs![E-mail Address]) Then       'do not process NULLs
    emailTo = emailTo & rs![E-mail Address] & ";"
  End If
    rs.MoveNext
Loop
    
emailSubject = "A new comment has been added"

eBody = "<html><body style='font-family: Arial;'><b>" & "THIS IS AN AUTOMATED NOTIFICATION." & "</b><br/><br/>" & vbCr & vbCr
eBody = eBody & "Your Request was updated with a new comment." & "<br/><br/>" & vbCr & vbCr
eBody = eBody & "This is auto-generated do not reply!</body></html>"
            
Set outMail = outApp.CreateItem(olMailItem)

With outMail
  .Importance = olImportanceHigh
  .BodyFormat = olFormatHTML
  .To = Left$(emailTo, Len(emailTo) - 1)   'remove Trailing ';'
  .Subject = emailSubject
  .HTMLBody = eBody
    .Send
End With
    
rs.Close
Set rs = Nothing
Set db = Nothing
    
If outlookStarted Then
  outApp.Quit
End If
    
Set outMail = Nothing
Set outApp = Nothing

This post has been edited by ADezii: Mar 21 2019, 12:58 PM
Go to the top of the page
 
brunomac
post Mar 21 2019, 02:17 PM
Post#9



Posts: 9
Joined: 21-March 19



Interesting, copied / pasted code on my end and have same results as I have been having. Works great when my DEFs file has more than one row, if it has just one I get the too few parameters; makes no sense to me!

Thanks for taking a look guys!
Go to the top of the page
 
ADezii
post Mar 21 2019, 02:30 PM
Post#10



Posts: 2,399
Joined: 4-February 07
From: USA, Florida, Delray Beach


Very strange, any possibility of Uploading a copy of the DB stripped of any sensitive information?
Go to the top of the page
 
MadPiet
post Mar 21 2019, 02:44 PM
Post#11



Posts: 3,136
Joined: 27-February 09



What if you do this?

CODE
Public Sub SendMsg()

    Dim rs As DAO.Recordset
    
    Dim emailTo As String
    Dim emailSubject As String
    Dim eBody As String
    Dim outApp As Outlook.Application
    Dim outMail As Outlook.MailItem
    Dim outlookStarted As Boolean
        
    Const olMailItem = 0
    Const olImportanceHigh = 2
    Const olFormatHTML = 2
        
    On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If outApp Is Nothing Then
      Set outApp = CreateObject("Outlook.Application")
        outlookStarted = True
    End If
    
    
    eBody = "<html><body style='font-family: Arial;'><b>" & "THIS IS AN AUTOMATED NOTIFICATION." & "</b><br/><br/>" & vbCr & vbCr
    eBody = eBody & "Your Request was updated with a new comment." & "<br/><br/>" & vbCr & vbCr
    eBody = eBody & "This is auto-generated do not reply!</body></html>"
                

    emailSubject = "A new comment has been added"
    Set outMail = outApp.CreateItem(olMailItem)
    
    strSQL = "SELECT [E-Mail Address] FROM [Q_PTP_UpdateNotice] WHERE ptpdocID = 99 AND [E-Mail Address] IS NOT NULL"
        
    Set rs = CurrentDb.OpenRecordset(strSQL)
    rs.MoveFirst
    
    With outMail
      .Importance = olImportanceHigh
      .BodyFormat = olFormatHTML
      .Subject = emailSubject
      .HTMLBody = eBody
      
       Do Until rs.EOF
        .Recipients.Add (rs.Fields("E-Mail Address"))
        rs.MoveNext
      Loop
      .Send
    End With
        
    rs.Close
    Set rs = Nothing
    Set db = Nothing
        
    If outlookStarted Then
      outApp.Quit
    End If
        
    Set outMail = Nothing
    Set outApp = Nothing
End Sub


The "too few parameters" is a problem with your query. Does it have parameters?
Go to the top of the page
 
brunomac
post Mar 21 2019, 02:54 PM
Post#12



Posts: 9
Joined: 21-March 19



Its a huge project so that would take some work.

I am leaning to the query that is used in building the DEFs query; something funny seems to be going on there.

In that query I have a where statement that excludes the email address of the individual who makes the comment - figured there was no reason to have an email sent to the person. If I remove that where statement the email will send if only 1 email address returns. If 0 rows are returned I get the error again.

Going to play around with those queries and see if I can find the (probably obvious) issue.

Thanks again!
Go to the top of the page
 
ADezii
post Mar 21 2019, 03:02 PM
Post#13



Posts: 2,399
Joined: 4-February 07
From: USA, Florida, Delray Beach


QUOTE
I am leaning to the query that is used in building the DEFs query; something funny seems to be going on there.

Post the Query SQL if you can.
Go to the top of the page
 
brunomac
post Mar 21 2019, 03:19 PM
Post#14



Posts: 9
Joined: 21-March 19



Q_PTP_UpdateNotice is

CODE
SELECT EndUsers.[E-mail Address], PTP_Reviews.ptpdocID
FROM PTP_Reviews INNER JOIN EndUsers ON Reviews.empID = EndUsers.ID
WHERE (((EndUsers.UserDBLogin)<>[tempvars]![username]));


This query returns the fields [E-mail Address] and [ptpdocID] from all reviews accept for the reviews where the E-mail address is the individual who makes a comment. (figured no need to send the person who comments an email)

qd.SQL then selects all email addresses from that query where the docID matches the one where the comment is being made.

Thinking that where part in the first query could be what is throwing rocks at my glass wall; but I am not 100% that's all, because removing that where statement makes the function work when 1 record is returned; but if the DEFs return 0 records I get the too few parameters again.

Go to the top of the page
 
MadPiet
post Mar 21 2019, 03:23 PM
Post#15



Posts: 3,136
Joined: 27-February 09



Okay, how are you populating the Username variable?
Go to the top of the page
 
brunomac
post Mar 21 2019, 03:31 PM
Post#16



Posts: 9
Joined: 21-March 19



That is set/populated when the application opens.

TempVars("Username").Value = getWinUser()

Running Q_PTP_UpdateNotice query excludes the correct rows, so that var is being set ok.

Use the username variable in lots of other places without any issue.
Go to the top of the page
 
brunomac
post Mar 21 2019, 03:56 PM
Post#17



Posts: 9
Joined: 21-March 19



More info ...

Using your code without the use of DEFS

CODE
strSQL = "SELECT [E-Mail Address] FROM [Q_PTP_UpdateNotice] WHERE ptpdocID =" & TempVars("ptpDocnum") & " AND UserDBLogin <> " & TempVars("UserName") & ""


Gives the too few error ...

If I force in data

CODE
strSQL = "SELECT [E-Mail Address] FROM [Q_PTP_UpdateNotice] WHERE ptpdocID =2 AND UserDBLogin <> 'jdoe'"


It works!

Going to try and reset the username variable before that query see if it does anything.
Go to the top of the page
 
MadPiet
post Mar 21 2019, 04:19 PM
Post#18



Posts: 3,136
Joined: 27-February 09



How about
strSQL = "SELECT [E-Mail Address] FROM [Q_PTP_UpdateNotice] WHERE ptpdocID =" & TempVars("ptpDocnum") & " AND UserDBLogin <> '" & fGetOSUserName() & "'"
Go to the top of the page
 
cheekybuddha
post Mar 22 2019, 07:11 AM
Post#19


UtterAccess VIP
Posts: 11,329
Joined: 6-December 03
From: Telegraph Hill


@brunomac,

Do you notice how in your hardcoded version that works you have used single quotes to delimit your string parameter?

You need to do the same when building the SQL with variables:
CODE
strSQL = "SELECT [E-Mail Address] FROM [Q_PTP_UpdateNotice] WHERE ptpdocID = " & TempVars("ptpDocnum") & " AND UserDBLogin <> '" & TempVars("UserName") & "'"


hth,

d

--------------------


Regards,

David Marten
Go to the top of the page
 
brunomac
post Mar 22 2019, 07:21 AM
Post#20



Posts: 9
Joined: 21-March 19



BINGO!

WOW, these darn oversights that never jump off the page when you have over coded something end up being the simplest issues!

Guessing my original code would work using that as well - geesh sorry to waste your guys time, but thanks for helping me see the trees through the forest!
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    25th June 2019 - 01:13 PM