Updating Multiple Rows using .edit in vba access 2007 - vba

I hope I can ask this right.
I have a listbox on a form (access 2007) and have it set on "simple" so I can multi-select.
I am trying to update multiple columns in a table, based on the selections in the listbox. I have a few textboxes that I want to use as the information to update the table.
I have a loop that is only updating the first record in the table no matter how many items are selected.
I think I understand why it's only updating the first record from my loop but am not sure
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("Table1", dbOpenDynaset)
Dim i As Variant
For Each i In Listbox.ItemsSelected
With rs
.Edit
!Col1 = Me.Textbox1
!Col2 = Me.Textbox2
!Col3 = Me.Textbox3
.Update
End With
Next
I assume this is because I am not specifying the "where" in the loop I want my table updated, but I have no idea how to do this in this loop. I would have 3 columns in the listbox (at positions 1, 3 and 4) that all need to be included to specify which records in the table need to be updated. I have tried this as well using an sql query with DoCmd.RunSql but it seems impossible to change the focus of the ListIndex mid-query. Aplogies for my lack of knowledge I am pretty new to visual basic. Please Help

Simplified example how I would give it a try if I understood correctly:
Sub MultiSelect_Listbox()
Dim lCnt as Long
dim lID as long
dim sSQL_Update as string
dim sText_1 as String
dim sText_2 as String
dim sText_3 as String
dim bSuccess as Boolean
sText_1 = me.txt_Textbox_1
sText_2 = me.txt_Textbox_2
sText_3 = me.txt_Textbox_3
With Me.lst_Listbox
For lCnt = 1 To .ListCount
If .Selected(lCnt) Then
lID = .Column(0, lCnt - 1)
'Example update for 1 column
sSQL_Update = "UPDATE T_TABLE SET COL_TEXT_1 = '" & sText_1 & "' WHERE ID = " & lID & ";"
bSuccess = Update_Statement(sSQL_Update)
End If
Next
End With
End Sub
Public Function Update_Statement(sUpdate_Stmt) As Boolean
Dim db As Database
Set db = CurrentDb
db.Execute (sUpdate_Stmt)
Update_Statement = True
End Function

Related

MS Access SQL to Update a RecordSet in Table/Query

I need help regarding the WHERE clause of an SQL statement to UPDATE field values [olnAg] in a query (qryCLFull same as tblCLFull). The field [olnAg] should be updated to the second text of [cellLine] field. So for example if [cellLine] has "
This is the cellLine field
[olnAg] should have
is
Getting the recordset and values has been successful with the code below (with the click of a button on frmSecWord but the issue with UPDATE of the [olnAg] field.
Private Sub btnBySpace_Click()
Dim rsON As DAO.Recordset
Dim rsNN As DAO.Recordset
Dim db2 As Database
Dim sqlON As String
Dim sqlNN As String
Dim newVal As String
Dim arr As Variant
sqlON = " SELECT cellLine FROM qryCLFull"
sqlNN = " SELECT olnAg FROM qryCLFull"
Set db2 = CurrentDb
Set rsON = db2.OpenRecordset(sqlON)
Set rsNN = db2.OpenRecordset(sqlNN)
arr = Split(rsON!cellline, " ")
If IsNull(arr(1)) Then
newVal = arr(0)
Else: newVal = arr(1)
End If
Do Until rsON.EOF
If Not IsNull(rsON.Fields(0).Value) Then
sqlstr = "UPDATE qryCLFull SET qryCLFull.olnAg = '" & newVal & "'
db2.Execute sqlstr
End If
rsON.MoveNext
rsNN.MoveNext
Loop
rsON.Close
rsNN.Close
Set rsNN = Nothing
Set rsNN = Nothing
Set db2 = Nothing
End Sub
Now with this UPDATE and SQL code, all the records of [olNAg] are changed to "is" instead of records WHERE [CellLine] has the text "This is the cellLine field" I have tried severally to adjust the WHERE clause but I haven't been able to write a correct clause. This sql updates [olnAg] for all records in the table instead of just for instances where we find that particular rsON!CellLine. Help will be greatly appreciated.

Access VBA Update Form Textbox With Sub Parameter

I'm having an issue with figuring out how to update my forms textbox with the value I ended with in the procedure. If a messagebox is used the output is fine. However, I want the user to be able to click the button and the textbox on that form be updated with the answer.
Private Sub btnTotalGuests_Click()
Call CalculateTotalGuestsForEachService
End Sub
Here is the procedure
Public Sub CalculateTotalGuestsForEachService()
'Declare variables
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim intTotalParty As Integer
Dim intID As Integer
'Set the current database
Set db = CurrentDb
'Set the recordset
intID = InputBox("Enter the Service ID (1-6)", "Service ID")
Set rst = db.OpenRecordset("Select Orders.* From Orders Where ServiceID =" & intID)
'Cycle through the records
Do While Not rst.EOF
If Not IsNull(rst!NoInParty) Then
intTotalParty = intTotalParty + rst!NoInParty
End If
rst.MoveNext
Loop
'Display total amount
txtTotalGuests.Text = intTotalParty 'Wondering how to display this in the textbox on the form.
'Close the recordset
rst.Close
Set rst = Nothing
Set db = Nothing
End Sub
Don't use Text property. You want Value property and since Value is default, don't even need to explicitly reference. Presume CalculateTotalGuestsForEachService is in the form module so can use Me.txtTotalGuests.
Consider domain aggregate function instead of looping recordset.
Dim intID As Integer
intID = InputBox("Enter the Service ID (1-6)", "Service ID")
Me.txtTotalGuests = DSum("NoInParty", "Order", "ServiceID =" & intID)

MS ACCESS VBA Run-time error '3021'; with .MoveNext

this is my code
Dim Reloc, RelocPrev1, RelocPrev2 As String
Dim Blk, Blk2, Lt, Lt2, PrevDate As String
Dim LotComp, BlockComp As Integer
Dim DB As Database
Dim RS As Recordset
Private Sub SearchBtn_Click()
Reloc = Me.RArea.Value
Set DB = CurrentDb()
Set RS = DB.OpenRecordset(Reloc, dbOpenDynaset)
Blk = RS!Block
Lt = RS!Lot
Blk2 = Me.BlockTxt
Lt2 = Me.LotTxt
BlockComp = StrComp(Blk, Blk2, 1)
LotComp = StrComp(Lt, Lt2, 1)
RS.MoveFirst
Do Until BlockComp = LotComp
RS.MoveNext
Loop
Call RetrieveData
End Sub
RS!Block and RS!Lot works fine, only RS.Movenext and RS.Edit which I tried doesn't work.
My table is populated with more than 50 rows.
First item in the table can be pulled just fine, I just can't move to the next row with RS.MoveNext
Any ideas to make this work?
You apparently expect only 1 record to match criteria. It would be best to apply filter criteria to recordset SQL so only desired records are pulled then test if recordset is empty.
To go to a single record that meets criteria, instead of looping recordset use FindFirst and NoMatch.
RS.FindFirst "Block='" & Blk2 & "' AND Lot='" & Lt2 & "'"
If Not RS.NoMatch Then

How can I set an Excel Cell Value as the criteria for Access Query?

I am creating a new query in MS Access that updates an existing record based on the "Branch" and "Employee" fields. How can I set the criteria to reference cell values? Say A2 holds the "Branch" ID for Access and B2 holds the value for the "Employee" ID in Access.I want to update my Access "Notes" Field. My query works when running in Excel, but only because I have specified what the "Employee" & "Branch" ID's are. Nothing updates when i run my code below:
Code
Sub modify_record()
Dim ac As Object
Dim branchid As String
Dim employeeid As String
Dim notesF As String
Set ac = CreateObject("Access.Application")
branchid = Sheets("Sheet4").Range("A2")
employeeid = Sheets("Sheet4").Range("B2")
notesF = Sheets("Sheet4").Range("C2")
Dim strDatabasePath As String
strDatabasePath = "C:\Users\johnsmith\OneDrive\pbsbackup.mdb"
With ac
.OpenCurrentDatabase (strDatabasePath)
Dim db As Object
Set db = .CurrentDb
db.Execute "Update_Records"
End With
End Sub
Query in MS Access. Saved as Update_Records
UPDATE pbsmaster SET pbsmaster.notes = "notesF" WHERE
(((pbsmaster.branch)="branchid") AND((pbsmaster.employee)="employeeid"));
Your variables don't magically transfer into the query, just because they have the same name.
You need to specify the parameters in the Access query, and pass them via a DAO.QueryDef object in the Excel VBA code.
Here is an example: https://stackoverflow.com/a/2317225/3820271
Dim qd As Object ' DAO.QueryDef
Set qd = db.QueryDefs("Update_Records")
qd.Parameters("branchid") = branchid
' etc.
qd.Execute
Here is my solution from what I learned from #Andre. I am able to execute my code, I noticed working with Parameters is much quicker than opening a recordset with DAO.
Sub foo()
Dim db As Database
Dim qdf As QueryDef
Set db = OpenDatabase("C:\Users\employee\OneDrive\samplefile.mdb")
Set qdf = db.CreateQueryDef("", _
"PARAMETERS pbsbranch text , pbsnotes text; " & _
"UPDATE pbsmaster SET pbsmaster.notes=[pbsnotes] " & _
"WHERE pbsmaster.branch=[pbsbranch] " & _
"")
qdf!pbsbranch = Sheets("Sheet4").Range("A2")
qdf!pbsnotes = Sheets("Sheet4").Range("C2")
qdf.Execute dbFailOnError
Set qdf = Nothing
Set cdb = Nothing
End Sub

Error while creating table on TableDefs.Append showing Invalid Argument

I am writing a program in Access 2013. If it is the first time they will install the program, it will create an external database (that will be linked later) and will create the tables needed. In the attached code, I am running through an array that has a list of all the tables needed and using an internal (local) table that has all the fields associated with the particular table. It runs through the code and creates all the fields just fine, but once it gets to the line db1.TableDefs.Append newTable it throws the Invalid Argument error. I have searched as much as I can and it appears that my setup is the same as all others and cannot figure out what the issue is.
Function CreateDataTables()
Dim db As Database
Dim db1 As Database
Dim rst As Recordset
Dim tblCount As Integer
Dim rst1 As Recordset
Dim newTable As TableDef
Dim newField As Field
Dim newIdx As Index
Dim newType As Variant
Dim newLength As Variant
Dim newPK As String
Dim sysTable As String
Dim SQLstr As String
Dim x As Integer
Dim tblNames() As Variant
Stop
SQLstr = "SELECT DISTINCT tableName "
SQLstr = SQLstr + "FROM sysdata;"
Set db = DBEngine(0)(0)
Set rst = db.OpenRecordset(SQLstr, dbOpenSnapshot, dbSeeChanges)
tblCount = rst.RecordCount
'Creating array to house table names
ReDim tblNames(tblCount)
tblNames() = rst.GetRows(tblCount)
Set db = Nothing
Set rst = Nothing
Set db = DBEngine(0)(0)
Set rst = db.OpenRecordset("sysdata", dbOpenSnapshot, dbSeeChanges)
'Create database reference to newly created database in prior function
Set db1 = OpenDatabase(dbFileLoc)
For x = 1 To tblCount
'Create new tabledef
Set newTable = db1.CreateTableDef(tblNames(0, (x - 1)))
'Loop through each record of particular table (named in rst) to create each field
Do While rst.Fields("tableName") = tblNames(0, (x - 1))
newType = rst.Fields("typeData")
newLength = rst.Fields("lengthField")
newPK = Nz(rst.Fields("PKey"), "No")
Set newField = newTable.CreateField(rst.Fields("fieldName"))
With newField
.Type = newType
If Not IsNull(newLength) Then .Size = newLength
'If field is indicated as a PK, this will create the PK
If newPK = "Yes" Then
With newTable
newField.Attributes = dbAutoIncrField
Set newIdx = .CreateIndex("PrimaryKey")
newIdx.Fields.Append newIdx.CreateField(tblNames(0, (x - 1)))
newIdx.Primary = True
.Indexes.Append newIdx
End With
End If
End With
'Append field
newTable.Fields.Append newField
rst.MoveNext
If rst.EOF Then Exit Do
Loop
MsgBox "Table " + newTable.NAME + " create", vbOKOnly 'Placed to verify loop was completed and showing table name
'''The line below gives the Invalid Argument error
'''Do not know what is causing this
db1.TableDefs.Append newTable
db1.TableDefs.Refresh
Next
I finally ended up figuring out that the numbers in my sysdata table that was designating the Field Type were wrong. I even got the from a MSDN site. I ran through a loop to determine the actual number of the data types and then placed them in the table and it worked! I also located another bug in the code having to do with the Primary Key. Where I'm appending the Index, in the CreateField I have the Table name and not the Field name. Once I changed that, the PK populated as it should too.