[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 342
  • Last Modified:

VBA: Getting SQL into String to use in Mail function.

Hello my dear Experts!

I've got a form called frmMain. This form has a number of tabs. One of those tabs is used to email data to certain users.

The field (To: in outlook) should be populated by the email adresses of users I've got in the database. The SQL to retrieve the email adresses is:

**********

SELECT [tblDeelnemer].[Deelnemer_Email]
FROM tblReservering INNER JOIN (tblDeelnemer INNER JOIN tblDeelnemer_Reservering ON [tblDeelnemer].[Deelnemer_ID]=[tblDeelnemer_Reservering].[Deelnemer_ID]) ON [tblReservering].[Reserverings_ID]=[tblDeelnemer_Reservering].[Reserverings_ID]
WHERE ((([tblDeelnemer_Reservering].[Reserverings_ID])=[Forms]![frmMain]![Reserverings_ID]));

**********

On the Tab I've also got a button "Bevestigen" which initiates the email procedure. It's got the following code:

**********

Private Sub Bevestigen_Click()

    ' Prevent error screen if user cancels without sending mail.
    On Error Resume Next
   
    Dim strToWhom     As String
    Dim strMsgBody    As String
    Dim intSeeOutlook As Integer
    Dim strSubject    As String
       
    strMsgBody = Me.txtBody
    strSubject = Me.txtSubject
       
    DoCmd.SendObject acSendQuery, "qryDatum_Overzicht", acFormatRTF, _
              strToWhom, "Zoetermeer@info.nl", , strSubject, _
              strMsgBody, intSeeOutlook

End Sub

**********

I want to populate the string strToWhom with email adresses (Above SQL) .

Any help is welcome!
0
Geerd
Asked:
Geerd
2 Solutions
 
jjafferrCommented:
Hi Geerd

I don't know how to do it with the SQL, but I can show you how to to do it another way,

1-
Add a field in the SQL to count the number of resultant emails.
2-
Create a contiuous Form call it EmailForm which will read its Emails form the above SQL, call the To email field as ToEmail, call the count as TotalRecords
3-
This code should be in Private Sub Bevestigen_Click(), before the rest of the existing code:

strToWhom=""
docmd.open, acForm "EmailForm"
For i=1 to TotalRecords
strToWhom=strToWhom & ";" & me!ToEmail
if i<TotalRecords then docmd.gotorecord, acNext
next i
strToWhom=left(strToWhom,2)
docmd.close "EmailForm"


thats it,

Please fine tune the code as I am doing it off my head.

Hopethis helps

jaffer
0
 
walterecookCommented:
So you need a recordset?
Set a reference to DAo 3.6 Object library

dim rs as dao.recordset
dim sSQL
sSQL = "SELECT [tblDeelnemer].[Deelnemer_Email]
FROM tblReservering INNER JOIN (tblDeelnemer INNER JOIN tblDeelnemer_Reservering ON [tblDeelnemer].[Deelnemer_ID]=[tblDeelnemer_Reservering].[Deelnemer_ID]) ON [tblReservering].[Reserverings_ID]=[tblDeelnemer_Reservering].[Reserverings_ID]
WHERE ((([tblDeelnemer_Reservering].[Reserverings_ID])=[Forms]![frmMain]![Reserverings_ID]));"

set rs = currentdb.openrecordset(sSQL)
strToWhom = ""
do until rs.eof
 strToWhom = strtoWhom & rs.fields(0) & ","
rs.movenext
loop
set rs = nothing
strtoWhom = left(strTowhom, len(strToWhom)-1) ' strip final comma

I haven't tested this but it looks pretty good.
Hope it helps
Walt
0
 
stevbeCommented:
save your SQL as a query called qselMailDistributionList


Private Sub Bevestigen_Click()

    ' Prevent error screen if user cancels without sending mail.
    On Error Resume Next
    'I would capture the exact error and bypass that one rather than skip all errors


    Dim strToWhom     As String
    Dim strMsgBody    As String
    Dim intSeeOutlook As Integer
    Dim strSubject    As String
    Dim rst As DAO.Recordset

    Set rst = CurrentDB.OpenRecordset("SELECT * FROM qselMailDistributionList")

    Do While Not rst.EOF
        strToWhom= strToWhom & rst!Deelnemer_Email  & ";"
        rst.MoveNext
    Loop
    rst.Close
    Set rst = Nothing
       
    strMsgBody = Me.txtBody
    strSubject = Me.txtSubject
       
    DoCmd.SendObject acSendQuery, "qryDatum_Overzicht", acFormatRTF, _
              strToWhom, "Zoetermeer@info.nl", , strSubject, _
              strMsgBody, intSeeOutlook

End Sub

Steve
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
Rey Obrero (Capricorn1)Commented:
Try this

Private Sub Bevestigen_Click()
Dim rst As Recordset, db As Database
Dim strEmail as String
Dim strToWhom As String

strEmail = "SELECT [tblDeelnemer].[Deelnemer_Email] "
strEmail = strEmail & "FROM tblReservering INNER JOIN (tblDeelnemer INNER JOIN tblDeelnemer_Reservering "
strEmail = strEmail & "ON [tblDeelnemer].[Deelnemer_ID]=[tblDeelnemer_Reservering].[Deelnemer_ID]) "
strEmail = strEmail & "ON [tblReservering].[Reserverings_ID]=[tblDeelnemer_Reservering].[Reserverings_ID] "
strEmail = strEmail & "WHERE ((([tblDeelnemer_Reservering].[Reserverings_ID])=[Forms]![frmMain]![Reserverings_ID]));"

Set db = CurrentDb()
Set rst=db.OpenRecordset("strEmail")
  If rst.BOF And rst.EOF Then
    MsgBox "No records to process"
  Else
    rst.MoveFirst
    Do Until rst.EOF
      strToWhom = strToWhom &";" &  rst.Fields(0)
      rst.MoveNext
    Loop
    Set rst = Nothing
    Set db = Nothing
  End If


0
 
GeerdAuthor Commented:
Hi Walt,

your solution looks good. I pasted the date into my form.

Could you show me how I can break up the SQL...... it must be someting like & _
but I'm nog sure. The second line that starts with  "FROM" is coloured red.

Ive got a good feeling about your solution



0
 
walterecookCommented:
Oh yea,
either put it all all one line (works but not pretty) or add quote and & and _'s
"SELECT [tblDeelnemer].[Deelnemer_Email]" & _
"FROM tblReservering INNER JOIN (tblDeelnemer INNER JOIN tblDeelnemer_Reservering ON [tblDeelnemer].[Deelnemer_ID]" & _
"=[tblDeelnemer_Reservering].[Deelnemer_ID]) ON [tblReservering].[Reserverings_ID]=[tblDeelnemer_Reservering].[Reserverings_ID]" & _
"WHERE ((([tblDeelnemer_Reservering].[Reserverings_ID])=[Forms]![frmMain]![Reserverings_ID]));"

That help?

Walt


0
 
GeerdAuthor Commented:
Hi Walt.....

I don't exactly know what is going on now. I did what you told me and I think it's pretty good. But when I push my button everything grinds to a halt. Access is not responding anymore. I need to start up again. I don't know whats going on because I don't even get an error message. I'm using the code below.

Private Sub Bevestigen_Click()

    ' Prevent error screen if user cancels without sending mail.
    On Error Resume Next
   
    Dim strToWhom     As String
    Dim strMsgBody    As String
    Dim intSeeOutlook As Integer
    Dim strSubject    As String
       
    'hier de code van expert
   
    Dim rs As DAO.Recordset
    Dim sSQL

sSQL = "SELECT [tblDeelnemer].[Deelnemer_Email]" & _
       "FROM tblReservering INNER JOIN (tblDeelnemer INNER JOIN tblDeelnemer_Reservering ON [tblDeelnemer].[Deelnemer_ID]=[tblDeelnemer_Reservering].[Deelnemer_ID]) ON [tblReservering].[Reserverings_ID]=[tblDeelnemer_Reservering].[Reserverings_ID]" & _
       "WHERE ((([tblDeelnemer_Reservering].[Reserverings_ID])=[Forms]![frmMain]![Reserverings_ID]));"

Set rs = CurrentDb.OpenRecordset(sSQL)
strToWhom = ""
Do Until rs.EOF
 strToWhom = strToWhom & rs.Fields(0) & ","
rs.MoveNext
Loop
Set rs = Nothing
strToWhom = Left(strToWhom, Len(strToWhom) - 1) ' strip final comma
   
    strMsgBody = Me.txtBody
    strSubject = Me.txtSubject
   
   
   
    DoCmd.SendObject acSendQuery, "qryDatum_Overzicht", acFormatRTF, _
              strToWhom, "Zoetermeer@info.nl", , strSubject, _
              strMsgBody, intSeeOutlook

End Sub


Do you know what's going on?

ThanX

BTW: thanks for all the comments by the other experts, I can only handle one at a time :-)
0
 
GeerdAuthor Commented:
Walt,

Perhaps we need to Dim the sSQL?

0
 
walterecookCommented:
Well geerd
You have dim sSQL
Everything looks ok so I'd put a breakpoint in and make sure strTowhom is being built.
If not it would seem your SQL is not returning anything.
Is it possible that strToWhom is TOO long?

Walt
0
 
GeerdAuthor Commented:
No, strToWhom has only got 2 email adresses (about 30 characters)
I've got the SQL in a query that returns 2 two email adresses when frmMain is open.

I can't debug because everything locks when I push the button.....

What do you mean with a "breakpoint" ?
0
 
walterecookCommented:
Stop your code to debug.  
If you are sitting on the line of code hit F9.  It will turn red.  Walk through your code from there.

Walt
0
 
GeerdAuthor Commented:
When I'm viewing the code and press the run button with de frmMain open I can't execute the code.
A popup window asks me for the macro????

When I try to insert a breakpoint for debugging a message tells me I can't insert one.

Hellllllpppppp please!!!!

I'll increase the point!!!
0
 
Emanon_ConsultingCommented:
Hi Geerd,

If you're interested...
I use a form with a couple of tabs on it to gererate email to multiple contacts.
This is what it looks like...

Mine sends to one 'To' address and multiple 'Cc' address's
User types Subject and Body and can select what report from the application they want to attach.  It is set up for only one attachment (at this time).
I use Unbound Fields for all.  The 'To' and 'Cc' email addresses come from record source queries.

txtTo                    Combo Box (bad naming convention should be 'cboTo')
txtSubject             Text Box
txtBody                 Text Box
cboObject             Combo Box (yeah for naming convention)
lstSelectContacts   List Box

I have a Command button (cmdSendEmail) to execute my code.
I also have a command button (cmdSelectAll) to select all of the contacts in the list box for 'Cc'
And a command button (cmdDeselectAll) to deselect all the contacts in the list box for 'Cc'

Here's all the code...  (forgive the lack of comments)

'************Start Code*****************
Option Compare Database
Option Explicit

Dim lngCount As Long
Dim lngListCount As Long
Dim lstCC As Access.ListBox

Private Sub cmdSelectAll_Click()

On Error GoTo ErrorHandler

    Set lstCC = Me![lstSelectContacts]
    lngListCount = Me![lstSelectContacts].ListCount
   
    For lngCount = 0 To lngListCount
        lstCC.Selected(lngCount) = True
    Next lngCount
   
ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
   Resume ErrorHandlerExit

End Sub

Private Sub cmdDeselectAll_Click()

On Error GoTo ErrorHandler

    Set lstCC = Me![lstSelectContacts]
    lngListCount = Me![lstSelectContacts].ListCount
   
    For lngCount = 0 To lngListCount
        lstCC.Selected(lngCount) = False
    Next lngCount
   
ErrorHandlerExit:
    Exit Sub

ErrorHandler:
    MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
    Resume ErrorHandlerExit

End Sub

Private Sub cmdSendEmail_Click()

    ' Prevent error screen if user cancels without sending mail.
    On Error Resume Next
   
    Dim strTo As String
    Dim strCC As String
    Dim varCC As Variant
    Dim strEMailRecipient
   
    Dim strAttachment As String
    Dim varAttach As Variant
    Dim lstAttach As Access.ListBox
    Dim strEMailAttachment
    Dim strSubject As String
    Dim strMsgBody As String
    Dim intSeeOutlook As Integer
   
    If IsNull(Me.txtTo) Then
        MsgBox "Please enter a To... Contact", vbInformation, conAppName
        Me.txtTo.SetFocus
        GoTo ErrorHandlerExit
    ElseIf IsNull(Me.txtSubject) Then
        MsgBox "Please enter a subject", vbInformation, conAppName
        Me.txtSubject.SetFocus
        GoTo ErrorHandlerExit
    ElseIf IsNull(Me.txtBody) Then
        MsgBox "Please enter a message body", vbInformation, conAppName
        Me.txtBody.SetFocus
        GoTo ErrorHandlerExit
    End If
   
    ' Determine if user wants to preview message in Outlook window.
    intSeeOutlook = MsgBox("Preview e-mail message before sending?", _
                        vbYesNo, conAppName)

    ' If user wants to directly send item, get recipient's address.
    If intSeeOutlook = vbNo Then
        intSeeOutlook = False
    End If
   
    Set lstCC = Me.lstSelectContacts
Set lstAttach = Me.lstSelectAttachment
       
        'Add contacts to variable for CC field
        For Each varCC In lstCC.ItemsSelected
            'Check for email address
            strEMailRecipient = Nz(lstCC.Column(1, varCC))
            Debug.Print "EMail address: " & strEMailRecipient
            If strEMailRecipient <> "" Then
                strCC = strCC & strEMailRecipient & ";"
            End If
        Next varCC
       
'Add Attachments to variable for Attachment field
For Each varAttach In lstAttach.ItemsSelected
    'Check for ?
    strEMailAttachment = Nz(lstAttach.Column(1, varAttach))
    Debug.Print "EMail attachment: " & strEMailAttachment
    If strEMailAttachment <> "" Then
        strAttachment = strAttachment & strEMailAttachment & ";"
    End If
Next varAttach
       
        strCC = Left(strCC, Len(strCC) - 1)
        strTo = Me.txtTo.Value
        strSubject = Me.txtSubject.Value
        strMsgBody = Me.txtBody
        strAttachment = Me.cboObject
   
    ' Send in RTF format.
    ' Open Outlook window if intSeeOutlook is True.
    DoCmd.SendObject acSendReport, strAttachment, acFormatSNP, _
              strTo, strCC, , strSubject, _
              strMsgBody, intSeeOutlook
             
ErrorHandlerExit:
    Exit Sub

ErrorHandler:
    MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
    Resume ErrorHandlerExit

End Sub

'************Code End*******************

Hope some of this is helpful...
Good Luck!
Cheers
M
0
 
walterecookCommented:
- To put in a breakpoint, the code execution must be stopped.  It sounds like you may have already been in break mode.
The event on your button should say [event procedure], does it?  If it does not, whatever you have there, Access thinks is the name of a macro.
Click on that line then click the ... to the right.

Walt
0

Featured Post

Microsoft Certification Exam 74-409

VeeamĀ® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now