I'm trying to make a button function for deleting rows.
My code:
CurrentDb.Execute " Delete * from tblAsset where AssetID = '" & Me.tblAssetsub.Form.Recordset.Fields(0) & "' "
tblAssetsub.Form.Requery
MsgBox "Data has been Deleted"
Me.tblAssetsub.Requery
The problem is, sometimes, it gives an error when I click the button even there is a selected data. Please help me.
You could use the RecordsetClone:
Dim rs As DAO.Recordset
Dim ThisID As String
With Me!tblAssetsub.Form
Set rs = .RecordsetClone
If rs.RecordCount > 0 Then
ThisID = !AssetID.Value ' or what matches .Fields(0).
While rs.EOF = False
If rs!AssetID.Value = ThisID Then
rs.Delete
End If
rs.MoveNext
Wend
MsgBox "Data has been deleted."
End If
Set rs = Nothing
End With
No requery will be needed.
Related
I am trying to go through my forms checkboxes and If True, I need to check to see if the record exists and then, If it exists and True - Do Nothing. If True and Doesn't exist - Add the record.
If False - I also need to check if it exists and If it exists - Delete it, and If it doesn't - Do nothing.
I have tried using just recordset and looping through the table.
I also tried using DLookup and just got lost with needing three criteria values to find the record.
Now I am trying to use both recordset and SQL and keep getting the error "too few parameters".
RT = "Rise Time"
If Me.RiseTime.Value = True Then
strSQL = "SELECT * FROM Weekly_StartTime_Challenges WHERE UserID = '" &
Me.UserID.Value & "' AND WeekNumber = '" & Me.WeekNumber.Value
& "' AND StartTimeAction =" & RT
Set sast = db.OpenRecordset(strSQL, dbOpenDynaset)
If Not sast.EOF And sast.BOF Then
' It Does Exist and Do Nothing
Else
sast.AddNew
sast!WeekNumber = Me.WeekNumber.Value
sast!StartDate = Me.StartDate.Value
sast!UserID = Me.UserID.Value
sast!FullName = Me.FullName.Value
sast!Index = 1
sast!Tab1 = 8
sast!StartTimeAction = RT
sast.Update
End If
Else
strSQL = "SELECT * FROM Weekly_StartTime_Challenges WHERE UserID = '" &
Me.UserID.Value & "' AND WeekNumber = '" & Me.WeekNumber.Value & "' AND
StartTimeAction = RT"
Set sast = db.OpenRecordset(strSQL, dbOpenDynaset)
If Not sast.EOF And sast.BOF Then
' It Does Exist and needs deleted
sast.Delete
Else
End If
End If
Do it step by step. For example if you want to check if a record exists:
If DCount("ColumnName", "TableName", "ID = 4") = 0 Then
MsgBox "No Record Found"
'Do stuf
Else
MsgBox "Record/Records found"
'Do other stuf
End If
If you find a record/s you can loop through it with a recordset:
Dim rs As RecordSet
Set rs = CurrentDb.OpenRecordset("Select * From Table", dbOpenDynaset)
rs.MoveFirst
Do Until rs.EOF
If "You want to Update the record" = True Then 'Apply your update condition
rs.Edit
rs.ID = 4 'Change ID
rs.Name = "New Name" 'Change Name
rs.Update
Else
'Do other stuf
End If
rs.MoveNext
Loop
rs.close
Set rs = Nothing
For changing a datarow you need always recordset rs.Edit and in the end rs.Update.
I have a first table called "BreedingTable" with primary key "ID" and "TransactionStatus" = "Active".
I have "Kidding form" data populated from the combo box to Text fields
Text2.value = "ID" from BreedingTable.
When I am done with all the process, I want to change TransactionStatus of Breeding table = Closed.
I am using the below code but it never works.
Note" if I give exact transaction id number it works fine,
but if I ask to find based on text2 it doesn't work.
My code is as follows:
Private Sub exitprograme3()
Me.Text2.SetFocus
Dim i As Integer
Dim db As Database
Dim rs As Recordset
Dim Trn As Integer
Set db = CurrentDb
Set rs = db.OpenRecordset("BreedingTable")
For i = 0 To rs.RecordCount - 1
Me.Text2.SetFocus
If rs.Fields("ID") = Me.Text2.Value Then
rs.Edit
rs.Fields("BreedingStatus") = "Closed"
rs.Update
End If
rs.MoveNext
Next i
rs.Close
Set rs = Nothing
db.Close
DoCmd.Close
End Sub
Please assist ...
If I type exact transaction id number in below if statement it works
If rs.Fields("ID") = "323" Then
this works fine.
But if I type like below it doesn't work
If rs.Fields("ID") = Me.Text2.Value Then
No loop is needed:
Private Sub exitprograme3()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("Select * From BreedingTable")
rs.FindFirst "[ID] = " & Me!Text2.Value & ""
' If ID is text, then quotes:
' rs.FindFirst "[ID] = '" & Me!Text2.Value & "'"
If Not rs.NoMatch Then
rs.Edit
rs.Fields("BreedingStatus").Value = "Closed"
rs.Update
End If
rs.Close
Set rs = Nothing
Set db = Nothing
DoCmd.Close
End Sub
I am writing a function that checks if the amount paid is equal or more to a number of items selected if they are checked. For this example there are 10 items with 10 check boxes. I could check one or more boxes in any order.If an item or more meets the condition it is cleared otherwise it remains.
Public Sub processItem1()
Dim db As DAO.Database
Dim pr As DAO.Recordset, so As DAO.Recordset
Dim strSQL1 As String
Dim strSQL2 As String
Set db = CurrentDb
strSQL1 = "SELECT * FROM PharmSales WHERE PharmSalesID= (SELECT MAX(PharmSalesID) FROM PharmSales WHERE HospitalNo='" & Me.txtRegNo & "' And TDate = #" & Format(Me.txtTDate, "M\/dd\/yyyy") & "# AND SalesItem1 = '" & Me.txtSalesItem1 & "')"
strSQL2 = "SELECT * FROM tblItem WHERE ItemName = '" & Me.txtSalesItem1 & "'"
Set pr = db.OpenRecordset(strSQL1)
Set so = db.OpenRecordset(strSQL2)
With pr
If Not .BOF And Not .EOF Then 'Ensure that the recordset contains records
.MoveLast
.MoveFirst
If .Updatable Then 'To ensure record is not locked by another user
.Edit 'Must start an update with the edit statement
![DispQty1] = Nz(![DispQty1] + Me.txtSalesQty1.Value, 0)
.Update
End If
End If
pr.Close 'Make sure you close the recordset..
Set pr = Nothing '...and set it to nothing
Set db = Nothing
End With
With so
If Not .BOF And Not .EOF Then 'Ensure that the recordset contains records
.MoveLast
.MoveFirst
If .Updatable Then 'To ensure record is not locked by another user
.Edit 'Must start an update with the edit statement
![Stock_Out] = Nz(![Stock_Out] + Me.txtSalesQty1.Value, Me.txtSalesQty1.Value)
![SO_Date] = Me.txtTDate
![Stock_In] = Nz(![Stock_In] + 0, 0)
.Update 'And finally we will need to confirm the update
End If
End If
so.Close 'Make sure you close the recordset..
ExitSub:
Set so = Nothing '...and set it to nothing
Set db = Nothing
End With
End Sub
For processItem2:
Public Sub processItem2()
Dim db As DAO.Database
Dim pr As DAO.Recordset, so As DAO.Recordset
Dim strSQL1 As String
Dim strSQL2 As String
Set db = CurrentDb
strSQL1 = "SELECT * FROM PharmSales WHERE PharmSalesID= (SELECT MAX(PharmSalesID) FROM PharmSales WHERE HospitalNo='" & Me.txtRegNo & "' And TDate = #" & Format(Me.txtTDate, "M\/dd\/yyyy") & "# AND SalesItem2 = '" & Me.txtSalesItem2 & "')"
strSQL2 = "SELECT * FROM tblItem WHERE ItemName = '" & Me.txtSalesItem2 & "'"
Set pr = db.OpenRecordset(strSQL1)
Set so = db.OpenRecordset(strSQL2)
With pr
If Not .BOF And Not .EOF Then 'Ensure that the recordset contains records
.MoveLast
.MoveFirst
If .Updatable Then 'To ensure record is not locked by another user
.Edit 'Must start an update with the edit statement
![DispQty2] = Nz(![DispQty2] + Me.txtSalesQty2.Value, 0)
.Update
End If
End If
pr.Close 'Make sure you close the recordset..
Set pr = Nothing '...and set it to nothing
Set db = Nothing
End With
With so
If Not .BOF And Not .EOF Then 'Ensure that the recordset contains records
.MoveLast
.MoveFirst
If .Updatable Then 'To ensure record is not locked by another user
.Edit 'Must start an update with the edit statement
![Stock_Out] = Nz(![Stock_Out] + Me.txtSalesQty2.Value, Me.txtSalesQty2.Value)
![SO_Date] = Me.txtTDate
![Stock_In] = Nz(![Stock_In] + 0, 0)
.Update 'And finally we will need to confirm the update
End If
End If
so.Close 'Make sure you close the recordset..
ExitSub:
Set so = Nothing '...and set it to nothing
Set db = Nothing
End With
End Sub
Don't ever copy&paste code like this. It is a maintenance nightmare.
You can loop over objects by concatenating their name at runtime:
Me("txtSalesItem" & i) ' form control
pr("DispQty" & i).Value ' recordset field
etc.
Side note:
With recordset
.MoveLast
.MoveFirst
These MoveLast/MoveFirst commands are unnecessary. You only need them if you want to get the correct .RecordCount of a recordset.
I have looked and looked for an answer and cannot translate the answers to my specific code. I have some code for an Access Database that works as an INSERT TO but I want it to UPDATE a table. I cannot get it to run after changing it to UPDATE.
The following code works and what it does is add values that meet the criteria to the beginning of an existing table. But I want it to update the existing blank column "O_StateRegion" in a table called "Sonoco2016_xlsx". My efforts of switching INSERT INTO to UPDATE have failed. (See second example of code for my efforts)
Private Sub InsertStateRegion()
On Error GoTo InsertRegions_Err
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("Select [OriginState] from [Sonoco2016_xlsx];")
rs.MoveFirst
While Not rs.EOF
strSQL = "UPDATE [Sonoco2016_xlsx] ([O_StateRegion])"
strSQL = strSQL & " SELECT [StateRegion] FROM [tblStates]"
strSQL = strSQL & " WHERE [tblStates].[StateAbbrev]='" & rs![OriginState] & "' "
db.Execute (strSQL), dbFailOnError
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Set db = Nothing
btnInsertRegions_Exit:
Exit Sub
InsertRegions_Err:
MsgBox Err.Description & " in btnInsertRegions"
Resume btnInsertRegions_Exit
End Sub
Below are my efforts to convert it to UPDATE
Private Sub btnInsertRegions_Click()
On Error GoTo InsertRegions_Err
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("Select [OriginState] from [Sonoco2016_xlsx];")
rs.MoveFirst
While Not rs.EOF
strSQL = "UPDATE [Sonoco2016_xlsx] ([O_StateRegion])"
strSQL = strSQL & " SET [Sonoco2016_xlsx].[O_StateRegion]=[tblStates].[StateRegion]"
strSQL = strSQL & " WHERE [tblStates].[StateAbbrev] = '" & rs![OriginState] & "' "
db.Execute (strSQL), dbFailOnError
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Set db = Nothing
btnInsertRegions_Exit:
Exit Sub
InsertRegions_Err:
MsgBox Err.Description & " in btnInsertRegions"
Resume btnInsertRegions_Exit
End Sub
The correct syntax for what you want to achieve is
UPDATE [Sonoco2016_xlsx]
INNER JOIN [tblStates]
ON [tblStates].[StateAbbrev] = [Sonoco2016_xlsx].[OriginState]
SET [Sonoco2016_xlsx].[O_StateRegion]=[tblStates].[StateRegion];
which you would execute without using a recordset.
Note, however, that this will only work if [StateAbbrev] has a unique index, e.g. if it is the primary key of [tblStates]. Otherwise, the update would be ambiguous.
Moreover, it is not possible to use a subquery in the set statement like
SET [Sonoco2016_xlsx].[O_StateRegion]=(SELECT [StateRegion]
FROM = [tblStates]
WHERE [StateAbbrev] = rs![OriginState])
because subqueries are prohibited in UPDATE statements.
Here is the answer that worked for me thanks to M Doerner!
Private Sub btnInsertRegions_Click()
On Error GoTo InsertRegions_Err
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("Select [OriginState] from [Sonoco2016_xlsx];")
rs.MoveFirst
While Not rs.EOF
strSQL = "UPDATE [Sonoco2016_xlsx] INNER JOIN [tblStates]"
strSQL = strSQL & " ON [tblStates].[StateAbbrev] = [Sonoco2016_xlsx].[OriginState]"
strSQL = strSQL & " SET [Sonoco2016_xlsx].[O_StateRegion]=[tblStates].[StateRegion]"
db.Execute (strSQL), dbFailOnError
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Set db = Nothing
btnInsertRegions_Exit:
Exit Sub
InsertRegions_Err:
MsgBox Err.Description & " in btnInsertRegions"
Resume btnInsertRegions_Exit
End Sub
I hope you can assist. For some reason I can not think of what I am doing wrong. Maybe a fresh pair of eyes would help.
pulling GL's and their currency value from a query.
each GL needs to populate text boxes in a report with have sequential names. Ex: GL1, GL2, GL3, etc.
Each GL Value (currency) needs to populate other text boxes named uniquely. Ex: GLV1, GLV2, GLV3, GLV4, etc.
Here is my script - any help would be appreciated.
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qry_GL_totals")
Dim GLField As Variant
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Unnecessary in this case, but still a good habit
RecordCount = 0
Do Until rs.EOF = True
RecordCount = RecordCount + 1
MsgBox (rs!GL & " " & rs!Expr1) 'MsgBox is just for testing
"[" & GLField & "]" =rs!GL
"[" & GLField & "T]" =rs!Expr1
rs.MoveNext
Loop
Else
End If
rs.Close
Set rs = Nothing
GLField = Null
End Sub
Update: This is what I have now and its failing still.
Private Sub Report_Load()
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qry_GL_totals")
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
i = 0
Do Until rs.EOF = True
i = i + 1
Me.Controls(GLField) = rs!GL
Me.Controls(GLField & "T") = rs!Expr1
rs.MoveNext
Loop
Else
End If
rs.Close
Set rs = Nothing
End Sub
Run-time error "438" Object doesn't support this property or method.
Maybe try:
Me.Controls(GLField) = rs!GL
Me.Controls(GLField & "T") = rs!Expr1
For your updated code:
Me.Controls("GL" & i) = rs!GL
Me.Controls("GLV" & i) = rs!Expr1
assuming your controls are named "GL1", "GL2", "GLV1", "GLV2" etc