RecordSet and Ms Access 2007 - ms-access

I have a query that has CustID with mutiple Business affiliated with the CustID. I can't use Dlookup because it only returns one variable. I want to show on a form that for this custID, here are all the businesses it's affiliated it. I want the Businesses to show up into a field (business) in another table on the form.
I started out by this
Public Sub OpenRecordset()
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("Q:businesses")
Do While Not rs.EOF
T:Custinfo!business = NAME (I am lost in between on how to identify the custid and place the businesses into the table field as a Dlookup)
rs.movenext
Loop
rs.Close
Set rs = Nothing
db.Close
End Sub
I keep looking at other examples but can't seem to tie together where the dlookup replacement will take place and how will you have to put this on a form as a datasheet?

You don't need a DLookup. You could do one of two things:
1) Use a listbox and set the recordsource equal to your query (assuming Q:businesses has been appropriately defined to give the businesses as a result)
2) Still need your query to be appropriate, but you could create a string with all of the businesses in it:
Public Sub OpenRecordset()
Dim db As Database
Dim rs As Recordset
Dim StrBusinesses As String
Set db = CurrentDb
Set rs = db.OpenRecordset("qryBusinesses")
If rs.EOF and rs.BOF Then
MsgBox("No businesses exist for this Customer")
Exit Sub 'Or do whatever else you want if there are no matches
Else
rs.MoveFirst
End If
StrBusinesses = ""
Do While Not rs.EOF
StrBusinesses = StrBusinesses & rs!Business & ", "
rs.movenext
Loop
rs.Close
StrBusinesses = Left(StrBusinesses, Len(StrBusinesses) - 2)
Forms!MyForm.MyField = StrBusinesses 'Set the field equal to the string here
Set rs = Nothing
db.Close
End Sub
Of course this assumes that the query "Q:Business" is defined to get the appropriate info such as:
SELECT custID, business FROM tblBusinesses WHERE custID = X
where "X" is the custID you are looking for.
If you need to set the query dynamically, you will need to set a querydef.
EDIT to include querydef code***********************
Also changed the name of the query to "qryBusinesses" in the code above and below as I'm not sure whether you can make a query with a colon in it.
To set the querydef, put this at the beginning of the code:
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs("qryBusinesses")
qdf.SQL = "SELECT custID, business FROM tblBusinesses" _
& " WHERE custID = " & Forms!MyForm.CustID 'replace with actual form and field
This assumes that i) qryBusinesses exists already,
ii) custID is a number field
EDIT**************
If you define the query to look at the form itself, you would not need to set the sql, so if the query were defined (either in VBA or through the query wizard) as:
qdf.sql = "SELECT custID, business FROM tblBusinesses" _
& " WHERE custID = Forms!MyForm.CustID"
then you would not need to redefine the sql. However, it is a bit more dynamic to put the custID into the qdf itself as it is easier to debug any issues as you can see the exact sql that is being run in the original method.

Related

How can I auto select items in a multiselect listbox related to values in a table?

So far I have accomplished the opposite of this - I have entered records into a table based on selections made in the multiselect listbox. The multiselect listbox was named "lstboxColor" and the table was named tblColors. This was accomplished with the following code:
Set rs = New ADODB.Recordset
Dim itm As Variant
cnnLocal.CursorLocation = adUseClient 'avoid error 3705
'SET UP A LOOP TO ADD A COLOR RECORD IN THE COLORS TABLE FOR EACH SELECTED COLOR
rs.Open "tblColors", cnnLocal, adOpenDynamic, adLockOptimistic
For Each itm In lstboxColor.ItemsSelected
rs.AddNew
rs!CrayonID = CrayonID_HOLD
rs!ColorID = lstboxColor.ItemData(itm)
rs.Update
Next
rs.Close
So, now I would like to do the reverse of this - I need to open a form with a listbox and have the items in the multiselect listbox automatically be pre-selected based on the values in the table. Just can't seem to figure out the method needed other than looping through the table and using an if statement and .Selected = true. Any ideas? Thank you in advance.
EDIT: Added current code that is almost working. Changed what I need to do - I am using 3 tables and having a combobox selection auto select rows in the listbox. The code is going in the combobox's AfterUpdate(). I added "Else: If rs.NoMatch Then .Selected(i) = False" - but that's not the problem. Thinking it may be the SQL query, but that same query pulls up the correct answer in a Subform, so I know the query works. Could it be the query that I am using for the listbox rows (which is only selecting EquipmentID and Equipment name from tblEquipment)? Please let me know what you think about the reason why it may only be highlighting one row in the listbox.
EDIT: This code is working for 3 tables. The selection in the combobox auto selects the correct rows in the listbox. Solution is marked for the 2 table version(or one table), but same concept.
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim i As Integer
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT tblMusicEquipment.EquipmentID, *
FROM tblMusic
INNER JOIN (tblEquipment INNER JOIN tblMusicEquipment
ON tblEquipment.EquipmentID = tblMusicEquipment.EquipmentID)
ON tblMusic.InstrumentID = tblMusicEquipment.InstrumentID
WHERE (((tblMusic.InstrumentID))) = " & [cboSelectInstrument])
With Me.LstEditEquip
For i = 0 To .ListCount - 1
rs.FindFirst "EquipmentID =" & .ItemData(i)
If Not rs.NoMatch Then
.Selected(i) = True
Else: If rs.NoMatch Then .Selected(i) = False
End If
Next
End With
Have to loop through listbox and compare to a value to determine selection. In your case, do a FindFirst on recordset. If match found then select item. Assuming value to match is a numeric key, consider:
Dim rs As DAO.Recordset, i As Integer
Set rs = CurrentDb.OpenRecordset("SELECT ColorID FROM tblColors WHERE CrayonID_HOLD=" & Me.CrayonID_HOLD)
With Me.lstboxColor
For i = 0 To .ListCount - 1
rs.FindFirst "ColorID = " & .ItemData(i)
.Selected(i) = Not rs.NoMatch
Next
End With

Create queries based on information in a table

I have some knowledge of Access and VBA programming, but I stress some. I haven't really used Access since college.
I have a table called Location with 2 fields: Postcode and a Group Code. This list has 1,693,353 records.
I have another table called Group with 2 fields: Group Name and Group Code.
There are about 300 different Authority Records.
I need to make a table/query for each Group and have the different location postcodes in the tables.
I know that I could go through and make 300 different queries all with the Group code as the criteria and that would match them up, but that means making 300 different queries.
What I would like to know is if there is a way of automating this process. I'm not asking for people to create it for me (unless they want to) but if there are any guides or tutorials that people could recommend for learning Access VBA that would help as well.
This query will contain all your groups (I've named it SQL_Group)
SELECT GroupName, Postcode FROM [Group] INNER JOIN Location ON Group.GroupCode = Location.GroupCode will create your groups.
This code will cycle through each group:
Public Sub FilterQuery()
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset
Dim rst_Groups As DAO.Recordset
Dim rst_Filtered As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set qdf = db.QueryDefs("SQL_Group")
Set rst = qdf.OpenRecordset
Set rst_Groups = db.OpenRecordset("Group")
With rst_Groups
If Not (.BOF And .EOF) Then
.MoveFirst
Do While Not .EOF
rst.Filter = "GroupName = '" & rst_Groups.Fields("GroupName") & "'"
Set rst_Filtered = rst.OpenRecordset
With rst_Filtered
If Not (.BOF And .EOF) Then
.MoveFirst
Do While Not .EOF
Debug.Print .Fields("GroupName") & " : " & .Fields("PostCode")
.MoveNext
Loop
End If
.Close
End With
.MoveNext
Loop
End If
.Close
End With
Set rst_Filtered = Nothing
Set rst = Nothing
Set rst_Groups = Nothing
End Sub

Run time error '3164': 'Field cannot be updated' - Access VBA issue

I'm having an issue with a piece of VBA I've written for Access. I have a table with a concatenation field 'Concat' (string field) and field called 'Age' (integer field with numerical values).
There are another 61 fields (named '0','1','2'...'60' respectively) where the code needs to work though: I want the code to loop through and, per record entry - for the VBA to Dlookup using the Concat + age fields to another table (called: tbl_Final_Probabilities) and pull back a probability and populate each of these 61 fields with the correct probability. These fields are set up at a numerical field, data type as Single.
The code pulls the correct probability but when I try to update the record for that field at the code line: "rs.Fields(a) = b" (also highlighted in code), I get the error message: "Run time error '3164': 'Field cannot be updated'".
All help welcome on how I need to correct this please, the code used is below.
Punch and pie.
Code:
Dim rs As DAO.Recordset
Dim a As Integer
Dim b As Single
Dim lookup As String
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_Circuit_plus_prob")
For a = 0 To 60
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
rs.Edit
lookup = rs!Concat & (rs!age + a)
b = DLookup("Prob_Date", "tbl_Final_Probabilities", "Concat2 = '" & lookup & "'")
rs.Fields(a) = b '- CODE BREAKS DOWN HERE
rs.Update
rs.MoveNext
Loop
End If
Next a
rs.Close
Set rs = Nothing
Thanks in advance for any and all help.
You loop is turned inside out:
Dim rs As DAO.Recordset
Dim a As Integer
Dim b As Single
Dim lookup As String
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_Circuit_plus_prob")
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
rs.Edit
For a = 0 To 60
lookup = rs!Concat & (rs!age + a)
b = DLookup("Prob_Date", "tbl_Final_Probabilities", "Concat2 = '" & lookup & "'")
rs.Fields(a).Value = b
Next
rs.Update
rs.MoveNext
Loop
End If
rs.Close
Set rs = Nothing
Your code: rs.Fields(a) = b addresses the field with the index 'a' (which is 0 in the first loop), in your table, this is probably an auto increment field and therefore cannot be updated. If you want to write in the fields with the names '0','1',... use this syntax: rs.Fields(x + a) = b, where x is the number of fields+1 (because your loop starts with 0) in the table existing before your field '0'.

Dynamic Query Criteria

I'm trying to make a Microsoft Access query depend on a value in another form's textbox.
This is the criteria, as it is now. Basically, any date between April 1st 2014, and March 31st 2015. This works well.
>=#2014-04-01# And <#2015-04-01#
I'd like to have a textbox with the year (with the current example 2014), and make the query criteria (2014, 2014+1) depend on this value.
I've tried to split the above syntax, then concatenate in the criteria, as such:
">=#" & "2014" & "-04-01# And <#" & "2015" & "-04-01#"
And I get an error "Data types in the criterion expression are incompatible".
1. Is it possible to concatenate in the query criteria?
I have also tried the SQL CONCAT(string1,string2,string3,..), to no avail.
If this is possible, then I guess I can use [Forms]![Form1].[Textbox1] and ([Forms]![Form1].[Textbox1] + 1) to replace the years.
If this is not possible...
2. Is there a better way to make the query criteria dynamic?
I tried to make the following solution work by creating a module with similar code:
Private m_varQueryParam As Variant
Public Function SetQueryParam(ByVal sValue as Variant)
m_varQueryParam = sValue
End Function
Public Function GetQueryParam() As Variant
GetQueryParam = m_varQueryParam
End Function
Query:
SELECT * FROM tblYourTable WHERE [FilterField] = GetQueryParam()
The VBA Code to launch the query will look like this.
SetQueryParam "your value here"
DoCmd.OpenQuery "qryYourQueryHere"
But I simply do not understand how to get this to work.
EDIT: I created a simple access database, to try to get this to work.
Textbox1, default value =Date()
bSave, button
tDateInfo, table: date (date/time), info (text) with random dates and info.
Query1:
SELECT tDateInfo.date, tDateInfo.info
FROM tDateInfo
WHERE (((tDateInfo.date)=GetQueryParam()));
Here's the form's vba code
Option Compare Database
Private Sub bSave_Click()
sValue = Me.TextBox1.Value
SetQueryParam (sValue)
End Sub
Here's the modules vba code
Option Compare Database
Option Explicit
'is this necessary?
Private m_varQueryParam As Variant
Public Function SetQueryParam(ByVal sValue As Variant)
m_varQueryParam = sValue
End Function
Public Function GetQueryParam() As Variant
GetQueryParam = m_varQueryParam
End Function
And the query criteria is GetQueryParam()
Thank you for your help.
Handling parameters and form fields is a little tricky with VBA. I created a simple table similar to yours as follows:
CREATE TABLE DateCalc (
ID AutoNumber,
FilterField DateTime
)
The following code will return your desired results:
Sub testthis()
Dim db As dao.database
Set db = CurrentDb ' use current database
Dim qd As dao.QueryDef
Set qd = db.CreateQueryDef("") ' create anaonymous querydef
' the SQL statement correctly concatenates the parameter (Useyear) and mm/dd strings
qd.sql = "SELECT * FROM DateCalc WHERE [FilterField] >= [UseYear]" & "-04-01 And [FilterField] < [UseYear]+1" & "-04-01"
qd!UseYear = Forms!DateCalc!txtYear ' set the value of se year from the Form WHICH MUST BE OPEN
' AND the TetBox filled with the year you desire - 2014 for this example.
Dim rs As dao.recordSet
Set rs = qd.OpenRecordset
MsgBox "ID=" & rs(0) & ", Date=" & rs(1)
End Sub
NEW VERSION
Sorry, there were a couple of date formatting problems with the first solution that the following code resolves. There are a number of other reasons for the error, so be sure the FormName is "DateCalc" and the TextBox is named "txtYear".
You should be able to generalize the following code for all your queries (do those actually work?). I pass the TableName in now as an example:
Sub DateFilter(TableName As String)
Dim db As dao.database
Set db = CurrentDb ' use current database
Dim qd As dao.QueryDef
Set qd = db.CreateQueryDef("") ' create anaonymous querydef
' the SQL statement correctly concatenates the parameter (Useyear) and mm/dd strings
Dim UseYear As Integer
UseYear = Forms!DateCalc!txtYear
Dim BegDate As Date
BegDate = CDate(UseYear & "-04-01")
Dim EndDate As Date
EndDate = CDate((UseYear + 1) & "-04-01")
qd.sql = "SELECT * FROM " & TableName & " WHERE [FilterField] >= [UseBegDate] And [FilterField] < [UseEndDate]"
qd!UseBegDate = BegDate
qd!UseEndDate = EndDate
Dim rs As dao.recordSet
Set rs = qd.OpenRecordset
Do While Not rs.EOF
MsgBox "ID=" & rs(0) & ", Date=" & rs(1)
rs.MoveNext
Loop
End Sub
I think I found a solution.
The following code defines the SQL as I require it, and changes the SQL for the Access query.
It's not ideal, because it requires me to rewrite all the SQL for the queries, but it works.
Sub ChangeQuery()
Dim Year, sqlTwo, StartDate, EndDate As String
Year = Me.txtYear.Value
StartDate = "4/1/" & Year
EndDate = "4/1/" & (Year + 1)
sqlTwo = "SELECT DateCalc.ID, DateCalc.FilterField FROM DateCalc WHERE (((DateCalc.FilterField)>=#" & StartDate & "# And DateCalc.FilterField<#" & EndDate & "#));"
tbTest.Value = sqlTwo
Dim oDB As Database
Dim oQuery As QueryDef
Set oDB = CurrentDb
Set oQuery = oDB.QueryDefs("Query1")
oQuery.SQL = sqlTwo
Set oQuery = Nothing
Set oDB = Nothing
End Sub
Private Sub Button_Click()
ChangeQuery
End Sub

How to search a field in a table in Access

Using VBA, how can I search for a text string, for example "CHIR", in a table called "ServiceYES", in the field "Service".
After that, I would like to save the neighboring field for all the rows that "CHIR" exists in the table "ServicesYES". The "ServiceYES" table is below:
I basically, want to find all the "CHIR" in "Service" column and then save the names which are on the left of the CHIR, eg "FRANKL_L", "SANTIA_D" as an array.
Thanks for all your help in advance.
Start by creating a SELECT query.
SELECT Code_Perso
FROM ServicesYES
WHERE Service = 'CHIR';
Use SELECT DISTINCT Code_Perso if you want only the unique values.
Add ORDER BY Code_Perso if you care to have them sorted alphabetically.
Once you have a satisfactory query, open a DAO recordset based on that query, and loop through the Code_Perso values it returns.
You don't need to load them directly into your final array. It might be easier to add them to a comma-separated string. Afterward you can use the Split() function (assuming you have Access version >= 2000) to create your array.
Here's sample code to get you started. It's mostly standard boiler-plate, but it might actually work ... once you give it "yourquery".
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strItems As String
Dim varItems As Variant
Set db = CurrentDb
Set rs = db.OpenRecordset("yourquery", dbOpenSnapshot)
With rs
Do While Not .EOF
strItems = strItems & "," & !Code_Perso
.MoveNext
Loop
.Close
End With
If Len(strItems) > 0 Then
' discard leading comma '
strItems = Mid(strItems, 2)
varItems = Split(strItems, ",")
Else
MsgBox "Oops. No matching rows found."
End If
Set rs = Nothing
Set db = Nothing
I tested this and it seems to work. This function will pull all records where ServiceYes='CHIR' and dump the Code_Person value into an array which it will return:
Function x() As String()
Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset( _
"Select * from ServiceYES where Service='CHIR'")
Dim Arr() As String
Dim i As Integer
While rst.EOF = False
ReDim Preserve Arr(i)
Arr(i) = rst.Fields("Code_Person")
i = i + 1
rst.MoveNext
Wend
x = Arr
End Function
Sample Usage:
Debug.Print x()(0)
Paolo,
Here is something I threw together in a few minutes. You can add it to the VBA editor in a module. It uses a trick to get the RecordCount property to behave properly. As for returing the array, you can update the function and create a calling routine. If you need that bit of code, just post a comment.
Thanks!
Option Compare Database
Function QueryServiceYES()
Dim db As Database
Dim saveItems() As String
Set db = CurrentDb
Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("SELECT Code_Perso, Service, Favorites " & _
"FROM ServiceYES " & _
"WHERE Service = 'CHIR'")
'bug in recordset, MoveFirst, then MoveLast forces correct invalid "RecordCount"
rs.MoveLast
rs.MoveFirst
ReDim Preserve saveItems(rs.RecordCount) As String
For i = 0 To rs.RecordCount - 1
saveItems(i) = rs.Fields("Code_Perso")
rs.MoveNext
Next i
'print them out
For i = 0 To UBound(saveItems) - 1
Debug.Print saveItems(i)
Next i
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Function