• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 448
  • Last Modified:

Create a recordset in VBA

Hi,

I have a form with 4 check boxes on.  I am trying to create a recordset based on whatever checkbox/s is selected by the user. As an example, the check boxes could be labeled:

Red
Blue
Green
Yellow

If a user selects Blue, then the recordset is set to:

Set rs = CurrentDb.OpenRecordset("tbl_members", WHERE [colour] = BLUE, dbOpenDynaset)  - (this is just air code)

Or if the user selects Red & Green, then the Recordset is:

Set rs = CurrentDb.OpenRecordset("tbl_members", WHERE [colour] = GREEN & RED, dbOpenDynaset) - (this is just air code)

This data is then passed to an email script.

I hope this makes sense :)

Thanks in advance.
0
anthonytr
Asked:
anthonytr
  • 7
  • 6
  • 2
1 Solution
 
Ess KayEntrapenuerCommented:
just do an if else statement,
0
 
anthonytrAuthor Commented:
does that mean i have to do an "if else statement" for every possible combination of check box selections?
0
 
Ess KayEntrapenuerCommented:
i would use dropbox/combobox  where you can select only one,
then do a case statement

dim rs as dataset
select combobox.value
   case "blue": rs = bla
   case "red": rs = blabla
   case else:
      exit sub
end select
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
anthonytrAuthor Commented:
Hi,
I could, but I want the user to be able to select more than one option
0
 
Ess KayEntrapenuerCommented:
yes, if you would have a combination checkbox system, then you would need to do each combination individually

1 box = 2 statements
2 boxes = 4 statements
3 boxes = 8 statements
4 boxes = 16 statements


hope that helps
0
 
Ess KayEntrapenuerCommented:
do something like this


if box3.checked = true then
   If box1.checked = true then
       if box2.checked = true then
            do stuff    ' both checked   (1,1,1)
       else
            do other stuff  ' (1,1,0)
   else
       if box2.checked = true then
            do more stuff '(1,0,1)
       else
            do more other stuff' (1,0,0)
   end if
else
   If box1.checked = true then
       if box2.checked = true then
            do stuff    ' both checked   (0,1,1)
       else
            do other stuff  ' (0,1,0)
   else
       if box2.checked = true then
            do more stuff '(0,0,1)
       else
            do more other stuff' (0,0,0)
   end if
end if
0
 
Ess KayEntrapenuerCommented:
sorry i must of misread the question, though you had different databases

in this case make 2 varaibles


Dim counter as colorcount = 0
Dim stringparam = ""

if box1.checked = true then
  stringparam = "red"
colorcount = 1
end if

if box2.checked = true & colorcount = 1 then
stringparam &= " & green"
else
stringparam = "green"
colorcount = 1
end if

if box3.checked = true & colorcount = 1 then
stringparam &= " & blue"
else
stringparam = "blue"
colorcount = 1
endif

if box4.checked = true & colorcount = 1 then
stringparam &= " & yellow"
else
stringparam = "yellow"
endif


Set rs = CurrentDb.OpenRecordset("tbl_members", WHERE [colour] = stringparam , dbOpenDynaset)
0
 
Rey Obrero (Capricorn1)Commented:
name your check boxes Red, Blue, Yellow, Green

use this codes

Dim ctl As Control, strColors As String, Sql As String
For Each ctl In Me.Controls
     If ctl.ControlType = acCheckBox Then
          If ctl = True Then
         
               strColors = strColors & "," & Chr(39) & ctl.Name & Chr(39)
          End If
     End If

Next
If strColors & "" <> "" Then
     strColors = Mid(strColors, 2)
     Sql = "Select * from tbl_members WHERE [colour] In(" & strColors & ")"
     set rs=currentdb.openrecordset(Sql)
End If
0
 
anthonytrAuthor Commented:
Hi,

Thanks for the input everyone.  Thought I would clarify something.  The colours I used were just for example.  The actual check boxes are:
Soprano
Alto
Tenor
Bass

Each check box will need to search the database for two fields, for example, Soprano is broken down to Soprano1 and Soprano2.  I think the counter might be the way forward, but instead of colours it would be "soprano1" & "soprano2".

Does this make sense, or have I mudded the water even more ;-)
0
 
Rey Obrero (Capricorn1)Commented:
i don't see the point of posting dummy names than posting the real names and the real problems.. you are wasting the time of experts who are volunteers to help you out..

please don't do this again.


use this revised codes


Dim ctl As Control, strVoices As String, Sql As String
For Each ctl In Me.Controls
     If ctl.ControlType = acCheckBox Then
          If ctl = True Then
         
               strVoices = strVoices & "," & Chr(39) & ctl.Name & Chr(39)
          End If
     End If

Next
If strVoices & "" <> "" Then
     strVoices = Mid(strVoices, 2)
     Sql = "Select * from tbl_members WHERE [soprano1] In(" & strVoices & ") or [soprano2] In(" & strVoices & ")"
     set rs=currentdb.openrecordset(Sql)
End If
0
 
anthonytrAuthor Commented:
How patronising could that comment be!  I see things haven't changed on EE.
0
 
anthonytrAuthor Commented:
Reynaldo, I could say the same with posting code/answers which have nothing to do with the actual question.  You are on here of your own free will.  It is you wasting your own time.

Thank you esskayb2d for your input, you have pointed me in the right direction,  I do appreciate it.
0
 
anthonytrAuthor Commented:
Thanks again for your input
0
 
Ess KayEntrapenuerCommented:
There might be an easier way,

Dim color1 = "" 
If checkbox1=true then color1 & = " & blue"
If checkbox2=true then color1 & = " & red"

Then remove the first & from the color1variable
0
 
anthonytrAuthor Commented:
Hi esskayb2d,

This is what i went with in the end.  I changed the check boxes to a listbox, allowing the user to select the items instead.  Works well, but... (see below code)

Private Sub cmd_send_Click()
Dim ctl As Control, strVoices As String, Sql As String
Dim strMailList As String, rs As Recordset

Set cdomsg = CreateObject("CDO.message")

With cdomsg.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "username"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
.Update
End With

If Me.lbVoices.ItemsSelected.Count = 0 Then
MsgBox ("Please select Voice Group(s) to send the email to.")
Exit Sub
  
Else

Sql = "SELECT * FROM tbl_members " & BuildFilter

Set rs = CurrentDb.OpenRecordset(Sql)

With rs
  .MoveFirst

    Do
      strMailList = strMailList & !email1 & ";"
        .MoveNext
    Loop Until .EOF

      strMailList = Left(strMailList, Len(strMailList) - 1)
        .Close
End With

With cdomsg
.bcc = strMailList
.From = "email address"
.subject = "Test Subject"
.TextBody = "Test Message"
.Send
End With
Set cdomsg = Nothing
End If
End Sub


Private Function BuildFilter() As Variant
    Dim varWhere As Variant
    Dim varVoice As Variant
    Dim varItem As Variant
    Dim intIndex As Integer

    varWhere = Null 
    varVoice = Null  
       
    ' Check for Voices in multiselect list
    For Each varItem In Me.lbVoices.ItemsSelected
        varVoice = varVoice & "[voice] = """ & _
                    Me.lbVoices.ItemData(varItem) & """ OR "
        
    Next
    
    ' Test to see if we have subfilter for Voices...
    If IsNull(varVoice) Then
        ' do nothing
      
    Else
        ' strip off last "OR" in the filter
        If Right(varVoice, 4) = " OR " Then
            varVoice = Left(varVoice, Len(varVoice) - 4)
        End If
        
        ' Add some parentheses around the subfilter
        varWhere = varWhere & "( " & varVoice & " )"
    End If
    
    ' Check if there is a filter to return...
    If IsNull(varWhere) Then
        varWhere = ""
    Else
        varWhere = "WHERE " & varWhere
        
        ' strip off last "AND" in the filter
        If Right(varWhere, 5) = " AND " Then
            varWhere = Left(varWhere, Len(varWhere) - 5)
        End If
    End If
    
    BuildFilter = varWhere
    
End Function

Open in new window


However I seem to have written in a loop and I don't know how.  When an email is generated with the code it seems to stay running (if I open VBA the session is still running), eventually i will get an error which stops the code on the [.Send] line.

Can you see anything obvious in my code which is causing this.  Not sure if its just my machine or its the code doing it.

Thanks.
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 7
  • 6
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now