I have an Access2017 database. On a form I have "PLCS Group" mulit-select listbox and "IPS Elements" the second multi-select listbox.
-----FIRST LIST-----
ID
GRAPES
APPLES
CHERRIES
LETTUCE
--------------------
-----SECOND LIST----
FK
COLD
DARK
LEAVE IN SUN
DIED
---------------------
So if someone selected GRAPES and APPLES from first list. And selected COLD,DIED from second list
This is what the second table should have it it.
GRAPES,COLD
GRAPES,DIED
APPLES,COLD
APPLES,DIED
I tried nesting the second listbox's records but that didn't update the tables.
I changed my code to what was suggested, But now I'm getting error 3020 "Update or CancelUpdate without AddNew or Edit"
I have AddNew statements in it I'm not sure what's making it not recognize them. If I comment out the second loop the first listboxes items are saved.
HERE'S MY UPDATED CODE:
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim ctl As Control
Dim ctl2 As Control
Dim varItem As Variant
Dim varItem2 As Variant
Set db = CurrentDb()
Set rs = db.OpenRecordset("ProposalTracker3", dbOpenDynaset, dbAppendOnly)
Set rs2 = db.OpenRecordset("IPSElementsDetails", dbOpenDynaset, dbAppendOnly)
Set ctl = Me.PLCSGroupListBox
Set ctl2 = Me.IPSList
For Each varItem In ctl.ItemsSelected
rs.AddNew
rs!GACP = ctl.ItemData(varItem)
rs.Update
For Each varItem2 In ctl2.ItemsSelected
rs2.AddNew
rs2!ProposalID = Me.txtID
rs2!Element = ctl2.ItemData(varItem2)
rs.Update
Next varItem2
rs2.Close
Next varItem
rs.Close
db.Close
It seems you want all possible combinations of the selected items of the two list boxes. You combine the entries with two nested loops
Set db = CurrentDb()
Set rs = db.OpenRecordset("DestinationTable", dbOpenDynaset, dbAppendOnly)
Set lb1 = Me.PLCSGroupListBox
Set lb2 = Me.IPSList
For Each item1 In lb1.ItemsSelected
For Each item2 In lb2.ItemsSelected
rs.AddNew
rs!Somefield = lb1.ItemData(item1) & ',' & lb2.ItemData(item2)
rs!ProposalID = Me.ID
rs.Update
Next item2
Next item1
rs.Close
db.Close
Or maybe you want to add the values from the two list boxes to two separate fields
rs.AddNew
rs!Somefield = lb1.ItemData(item1)
rs!Anotherfield = lb2.ItemData(item2)
...
Related
I am importing similar tables into a MS Access database to combine them into a larger data set. The first row of most of the columns are date fields. During import when the first row becomes field names, some of these dates stay dates "January-2018" and some of them become numbers "44001". I am writing a code to reference any numbers that are store as the field names and turn them into date values (ex. 44001 to January-2018).
Private Sub Command0_Click()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim rs As DAO.Recordset
Dim CurrentHead As String
Dim UpdateHead As String
Set db = CurrentDb
Set tdf = db.TableDefs("PL_1")
Set rs = db.OpenRecordset("TableUpdates")
rs.MoveFirst
Do While Not rs.EOF
For Each fld In tdf
If fld.Name = CurrentHead Then
fld.Name = UpdateHead
End If
rs.MoveNext
Loop
db.Close
Set db = Nothing
Set fld = Nothing
Set tdf = Nothing
MsgBox "Changed"
End Sub
I am running this syntax to query a table and set a texbox equal to the rs problem is the textbox is not actually setting to a value. It remains null. What should be altered in this so the textbox value is set to the value or rs
Dim rs As DAO.Recordset
Dim strSQL As String
Dim db As Database
Set db = CurrentDb
strSQL = "Select MAX(pkid)+1 from tblInfo"
Set rs = db.OpenRecordset(strSQL)
Do While Not rs.EOF
txtID = rs
Loop
First you are trying to set a recordset to a textbox object. You need to set the Text/Value of the textbox and you need to access the fields of the recordset.
Dim rs As DAO.Recordset
Dim strSQL As String
Dim db As Database
Set db = CurrentDb
strSQL = "Select MAX(pkid)+1 from tblInfo"
Set rs = db.OpenRecordset(strSQL)
Do While Not rs.EOF
txtID.SetFocus 'set the focus so we can add the text
txtID.Text = rs.Fields(0).Value
'txtID.Value = rs.Fields(0).Value 'uncomment out if you don't need focus on the textbox and comment out the previous 2 lines
Loop
You could do all this in a single line:
Me!txtID.Value = DMax("pkid", "tblInfo") + 1
I'm trying to write This Programm:
Function funktion()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rt As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("All")
Do While Not rs.EOF
Set rk = db.OpenRecordset("Archive")
'here I want to copy(append) the current index(of Table"All") into the next free
index (of table "archive")
Do something
rs.MoveNext
Loop
my programm works well just I need to append the current row from "All" into the next free row from table "Archive".
Thank you for your help
here´s a example of how you can do this using ADO and not DAO to access data.... in example above.. i add all records to another table... but easily you can just add the current record in your loop...
Dim cnn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim rs2 As ADODB.Recordset
Set cnn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set rs2 = New ADODB.Recordset
'open main recordset (TDetPed)
rs.Open "SELECT TDetPed.* FROM TDetPed WHERE CodPed = " & CodPed & "", cnn, adOpenKeyset, adLockOptimistic
'open clone table recordset (TDetPedTemp)
rs2.Open "TDetPedTemp", cnn, adOpenKeyset, adLockOptimistic
'move to first record of main table
rs.MoveFirst
'add record by record in clone table(rs2) from maintable(rs)
Do Until rs.EOF
rs2.AddNew
rs2("CodPed") = rs("CodPed")
rs2("CodDetPed") = rs("CodDetPed")
rs2("CodInterno") = rs("CodInterno")
rs2("DescrDetPed") = rs("DescrDetPed")
rs2("DescontoDetPed") = rs("DescontoDetPed")
rs2("CodProd") = rs("CodProd")
rs2("PreçoDetPed") = rs("PreçoDetPed")
rs2("QtdeDetPed") = rs("QtdeDetPed")
'update current added record in clone table
rs2.Update
'move to next record in main table
rs.MoveNext
'Move para o proximo registro do detalhe do pedido
Loop
'close everthing
rs.Close
rs2.Close
cnn.Close
'clean everthing
Set rs = Nothing
Set rs2 = Nothing
Set cnn = Nothing
Just completing the answer... a simple example using DAO (Data Access Objetcs) and not ADO(Active Data Objetcs). (more info https://msdn.microsoft.com/en-us/library/aa261340%28v=vs.60%29.aspx / http://www.utteraccess.com/wiki/index.php/Choosing_between_DAO_and_ADO)
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = dbsNorthwind.OpenRecordset("Tbl1")
rs.AddNew
rs!Cidade = "Curitiba"
rs!Country = "Brazil"
'.... others fields
rs.Update
I have a module with a procedure inside that looks like this:
Public Sub OpenRecordset()
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs("QOff2")
qdf.Parameters(0).Value = [Forms]![Form]![Text10]
Dim db As Database
Dim rs As Recordset
Dim StrBusinesses As String
Set rs = qdf.OpenRecordset
If rs.EOF And rs.BOF Then
MsgBox ("No businesses exist for this Customer")
Exit Sub
Else
rs.MoveFirst
End If
StrBusinesses = ""
Do While Not rs.EOF
StrBusinesses = StrBusinesses & rs!Fnam & ", "
rs.MoveNext
Loop
rs.Close
StrBusinesses = Left(StrBusinesses, Len(StrBusinesses) - 2)
Forms!Form.Badge = StrBusinesses
Set rs = Nothing
End Sub
I am trying to get this module to input the query results into a textbox (forms!form.badge), but I can't seem to get it to do it like my 5 other dlookup functions. When I open up the module and push the green play button, it shows up on the correct textbox but also shows up on the other records as well. It also doesn't show up automatically, nor does it update as you enter in the parameters. Isn't a module supposed to help autofil numerous variables into a text box in place of dlookup for multiple values?
No. If Forms!Form!Badge is an unbound textbox, a value assigned to it will be shown identically for all records.
To individualize, you will need a lookup function which takes the ID or other unique value of the record as parameter(add to textbox):
=LookupBadges([Forms]![Form]![Text10])
Public Function LookupBadges(ByVal Value As Variant) As Variant
Dim db As Database
Dim qd As QueryDef
Dim rs As Recordset
Dim Businesses As String
Set db = CurrentDb
Set qd = db.QueryDefs("QOff2")
qd.Parameters(0).Value = Nz(Value)
Set rs = qd.OpenRecordset
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
Businesses = Businesses & rs!Fnam.Value & ", "
rs.MoveNext
Loop
End If
rs.Close
Businesses = Left(Businesses, Len(Businesses) - 2)
LookupBadges = Businesses
Set rs = Nothing
Set qd = Nothing
Set db = Nothing
End Function
I have a continuous form with a command button in the footer that updates the current record with a value that will make the record no longer show in the form once requeried. I want the user to be able to click the button and once the record is updated, move to the next record, not the first as is the default behaviour. I have code that I would think should work but doesn't, it keeps going back to the first record on the form.
Private Sub cmdCloseReq_Click()
Dim ReqID As String
ReqID = Me.txtReqID
Dim rst As Recordset
Dim strBookmark As Integer
Set rst = Me.RecordsetClone
rst.MoveNext
If Not rst.EOF Then ' if not end-of-file
strBookmark = rst.Bookmark ' ...save the next record's bookmark
Dim cmd As New ADODB.Command
With cmd
.ActiveConnection = CurrentProject.Connection
.CommandType = adCmdStoredProc
.CommandText = "spUpdateLOG_ReqCompleteDate"
.Parameters("#ReqID") = ReqID
.Execute
End With
Me.Requery
Me.Bookmark = strBookmark
End If
Set rst = Nothing
End Sub
OK, I found a solution based on rene's post. I grab the next records primary key, do an update then after the requesry I find the next record and set the bookmark to that. Here is the code:
Private Sub cmdCloseReq_Click()
Dim ReqID As String
ReqID = Me.txtReqID
Dim rst As New ADODB.Recordset
Dim strBookmark As String
Set rst = Me.RecordsetClone
With rst
.Find "[ReqID] = '" & ReqID & "'"
.MoveNext
strBookmark = rst.Fields(0)
End With
If Not rst.EOF Then ' if not end-of-file
' ...save the next record's bookmark
Dim cmd As New ADODB.Command
With cmd
.ActiveConnection = CurrentProject.Connection
.CommandType = adCmdStoredProc
.CommandText = "spUpdateLOG_ReqCompleteDate"
.Parameters("#ReqID") = ReqID
.Execute
End With ' ...delete the record
Me.Requery
Set rst = Me.RecordsetClone
With rst
.Find "[reqID]= " & strBookmark
Me.Bookmark = .Bookmark
End With
Else
With cmd
.ActiveConnection = CurrentProject.Connection
.CommandType = adCmdStoredProc
.CommandText = "spUpdateLOG_ReqCompleteDate"
.Parameters("#ReqID") = ReqID
.Execute
End With ' ...delete the record
Me.Requery
End If
Set rst = Nothing
I recall that Bookmarks are invalidated after a Requery. If you have a primary key you can better grab that one and after requery move the current record to the previously obtained primary key