I'm trying to adjust this coding to select only userID's from table Attendance where [Programs] and [Language] match those form table CFRRR but I'm getting an error saying that I have too few parameters. I'm sure but it may be because I'm not referring to the other table here: Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
Here's the full code:
Public Function GetNextAssignee(program As String, language As String, username As String) As Long
' Returns UserID as a Long Integer with the lowest [TS] value,
' and updates same [TS] by incremented with 1.
Dim db As dao.Database
Dim rs As dao.Recordset
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT TOP 1 userID FROM attendance WHERE [Programs] LIKE CFRRR.program AND [Language] LIKE CFRRR.language AND [Status] = 'Available' ORDER BY TS ASC"
Debug.Print strSQL
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If Not rs.BOF And Not rs.EOF Then
strSQL = "UPDATE attendance SET TS = " & DMax("[TS]", "attendance") + 1 & " WHERE [userID]= " & rs!userID
db.Execute strSQL, dbFailOnError
GetNextAssignee = rs!userID
GetNextWorker = rs!username
Else
'Field TS has NO VALUE FOR ALL RECORDS!
'Code calling this function should check for a return of 0 indicating an error.
GetNextAssignee = 0
End If
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Function
Related
I have posted about this table and form multiple times and I know I shouldn't do it this way. I am having trouble with my code. I need for when the ToGo hits 0 then the row on the WorkOrders table moves to the Done WorkOrders table and then deletes out of the WorkOrders table. The code I had before was
Private Sub ItemCode_Dirty(Cancel As Integer)
Dim DB As DAO.Database
Dim rs As DAO.Recordset
Set DB = CurrentDb
Set rs = DB.OpenRecordset("Select ToGo from WorkOrders where ItemCode =" & Me.ItemCode)
With rs
.Edit
!ToGo = !ToGo - 1
.Update
.Edit
End With
End Sub
This was just making my code decrease by 1 every scan. So, I added the rest of the code to do the switch to a different table and then delete, but now my ToGo won't decrease at all. This is the updated code I have now with the if statement.
Private Sub ItemCode_Dirty(Cancel As Integer)
Dim DB As DAO.Database
Dim rs As DAO.Recordset
Dim i As Integer
Dim rsOld As DAO.Recordset
Dim rsNew As DAO.Recordset
Set DB = CurrentDb
Set rs = DB.OpenRecordset("Select ToGo from WorkOrders where ItemCode =" & Me.ItemCode)
Set rsNew = CurrentDb.OpenRecordset("SELECT * FROM WorkOrders")
Set rsOld = CurrentDb.OpenRecordset("Select * from WorkOrders where ItemCode =" & Me.ItemCode)
If ToGo > 0 Then
With rs
.Edit
!ToGo = !ToGo - 1
.Update
.Edit
End With
Else
rsNew.AddNew
For i = 0 To rsOld.Fields.Count - 1
rsNew.Fields(i).Value = rsOld.Fields(i).Value
Next
rsNew.Update
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM WorkOrders WHERE ItemCode= & Me.ItemCode
DoCmd.SetWarnings True
rsNew.Close
rsOld.Close
Set rsNew = Nothing
Set rsOld = Nothing
End If
End Sub
Can someone let me know if this is even possible.
Instead of 'moving' records between tables, change record status with edit in a field. You seem to already have a field that indicates a work order is 'done' - the ToGo field. Consider:
With rs
If Not .EOF Then
If !ToGo = 0 Then
.MoveNext
End If
.Edit
!ToGo = !ToGo - 1
.Update
End If
End With
I have two tables, ID table and Mastertable. In ID table i have level and activity which is given a start number, let us say 1000. In Mastertable i have many drawings associated to the same activity and level. I have to provide numbering to them starting from the ID table value 1000 and increment it by 1. After finishing, the max value from the mastertable has to be replugged to ID table.
Also, if there is Level and Activity, the ID has to be picked looking up for level and activity both, if no level is mentioned then it has to only lookup activity.
I tried a lot but could not succeed.
I used the Code below, but it looks up only Activity and not level. Also it does not go back to id table and update the max ID from the master Table.
Option Compare Database
Option Explicit
Public Function SequenceNew()
Dim strSQL As String
Dim db As Database
Dim rs As DAO.Recordset
Dim a, initNo As Integer
Dim b As Integer
strSQL = "SELECT * FROM MasterTable ORDER BY LevelID"
'Set db = CurrentDb
Set rs = CurrentDb.OpenRecordset(strSQL)
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
rs.Edit
If rs![DrawingTypeName] = "Concrete" And rs![ProjectName] = Forms!frm_Publish!CboProject And rs!IDGiven = "Not Given" Then
a = a + 1
rs!Sequence = DLookup("CONCRETE", "Qry_ID_Selected") + a
ElseIf rs![DrawingTypeName] = "Reinforcement" And rs![ProjectName] = Forms!frm_Publish!CboProject And rs!IDGiven = "Not Given" Then
b = b + 1
rs!Sequence = DLookup("REINFORCEMENT", "Qry_ID_Selected") + b
ElseIf rs![DrawingTypeName] = "Steel structural works" And rs![ProjectName] = Forms!frm_Publish!CboProject And rs!IDGiven = "Not Given" Then
End If
rs.Update
rs.MoveNext
Loop
rs.Close
Set db = Nothing
Else
MsgBox " No records Found"
rs.Close
Set db = Nothing
End If
End Function
There should be some other better way to do it.
MasterTable
ID Table
the issue is Resolved by the new code i could work out.
Option Compare Database
Option Explicit
Public Function SequenceNewLevel()
Dim strSQL As String
Dim strSQL1 As String
Dim db As Database
Dim rs As DAO.Recordset
Dim rs1 As DAO.Recordset2
Dim a, initNo As Integer
a = 0
strSQL = "SELECT * FROM MasterTable"
strSQL1 = "SELECT * FROM ID"
Set db = CurrentDb
Set rs1 = CurrentDb.OpenRecordset(strSQL1)
If rs1.RecordCount > 0 Then
rs1.MoveFirst
Do While Not rs1.EOF
rs1.Edit
Set rs = CurrentDb.OpenRecordset(strSQL)
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
rs.Edit
If rs![TypeOfDrawing] = rs1![Activity] And rs![Project] = rs1![Project] And rs![LevelName] = rs1![Level] And rs![IDGiven] = "Not Given" Then
a = a + 1
rs!Sequence = rs1!StartID + a
rs1!StartID = rs!Sequence
a = 0
rs![IDGiven] = "GIVEN"
End If
rs.Update
rs.MoveNext
Loop
End If
rs1.Update
rs1.MoveNext
Loop
rs1.Close
rs.Close
Set db = Nothing
Else
MsgBox " No records Found"
rs.Close
Set db = Nothing
End If
End Function
Public Function SequenceNewWithOutLevel()
Dim strSQL As String
Dim strSQL1 As String
Dim db As Database
Dim rs As DAO.Recordset
Dim rs1 As DAO.Recordset2
Dim a, initNo As Integer
a = 0
strSQL = "SELECT * FROM MasterTable"
strSQL1 = "SELECT * FROM IDWithoutlevel"
Set db = CurrentDb
Set rs1 = CurrentDb.OpenRecordset(strSQL1)
If rs1.RecordCount > 0 Then
rs1.MoveFirst
Do While Not rs1.EOF
rs1.Edit
Set rs = CurrentDb.OpenRecordset(strSQL)
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
rs.Edit
If rs![TypeOfDrawing] = rs1![Activity] And rs![Project] = rs1![Project] And rs![IDGiven] = "Not Given" Then
a = a + 1
rs!Sequence = rs1!StartID + a
rs1!StartID = rs!Sequence
a = 0
rs![IDGiven] = "GIVEN"
End If
rs.Update
rs.MoveNext
Loop
End If
rs1.Update
rs1.MoveNext
Loop
rs1.Close
rs.Close
Set db = Nothing
Else
MsgBox " No records Found"
rs.Close
Set db = Nothing
End If
End Function
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
Within the following code
Dim sqlStr As String
Dim OrgID As Long
Dim wrk As DAO.Workspace
Dim db As DAO.Database
Dim orgRS As DAO.Recordset
Dim staffRS As DAO.Recordset
Set wrk = DBEngine.Workspaces(0)
Set db = CurrentDb
On Error GoTo trans_Err
InsertOrganizationIntoTemp
'if staff fields are not blank Insert Staff into Temp
If (addStaffClickCheck = True) Then
staffNumber = staffNumber + 1
InsertStaffIntoTemp staffNumber
End If
wrk.BeginTrans
sqlStr = "INSERT INTO tblOrganization(OrganizationName, Affiliate, " _
& " UnionCouncil, DateJoined, OrganizationPhoneNumber, OrganizationFaxNumber, " _
& " MembershipGroup, TradeGroup, URL) " _
& " SELECT OrganizationName, Affiliate, CouncilUnion, DateJoined, OrganizationPhone, " _
& " OrganizationFax, MemberGroup, Trade, OrganizationWebsite " _
& " FROM tblTempOrganization;"
db.Execute sqlStr
OrgID = db.OpenRecordset("SELECT ##IDENTITY")(0)
sqlStr = "INSERT INTO tblAddresses(StreetName, CityName, StateName, " _
& " ZipCode, LocationID, OrganizationID) " _
& " SELECT OrganizationAddress, OrganizationCity, OrganizationState, " _
& " OrganizationZIP, OrganizationLocationType, '" & OrgID & "' " _
& " FROM tblTempOrganization;"
db.Execute sqlStr
'pull all staff and phones into two recordsets
'loop through staff and for each staff member add associated phone information
'Recordsets for temporary staff tables
Dim staffTempInfoRS As DAO.Recordset
Dim phoneTempInfoRS As DAO.Recordset
Set staffTempInfoRS = db.OpenRecordset("SELECT * FROM tblTempStaff", dbOpenDynaset)
'Recordsets for permanant staff tables
Dim StaffAddressID As Long
Dim StaffID As Long
'Check to see if the recordset actually contains rows
If Not (staffTempInfoRS.EOF And staffTempInfoRS.BOF) Then
staffTempInfoRS.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until staffTempInfoRS.EOF = True
'address information
Dim staffAddressDBRS As DAO.Recordset
Set staffAddressDBRS = db.OpenRecordset("tblStaffAddresses", dbOpenDynaset)
With staffAddressDBRS
.AddNew
.Fields("StaffStreet") = staffTempInfoRS.Fields("StaffStreet")
.Fields("StaffCity") = staffTempInfoRS.Fields("StaffCity")
.Fields("StaffState") = staffTempInfoRS.Fields("StaffState")
.Fields("StaffZip") = staffTempInfoRS.Fields("StaffZip")
.Update
End With
StaffAddressID = staffAddressDBRS.LastModified
staffAddressDBRS.Close
Set staffAddressDBRS = Nothing
'staff information
Dim staffInfoDBRS As DAO.Recordset
Set staffInfoDBRS = db.OpenRecordset("tblStaff", dbOpenDynaset)
With staffInfoDBRS
.AddNew
.Fields("StaffFirstName") = staffTempInfoRS.Fields("StaffFirstName")
.Fields("StaffLastName") = staffTempInfoRS.Fields("StaffLastName")
.Fields("Email") = staffTempInfoRS.Fields("Email")
.Fields("StaffAddressID") = StaffAddressID
.Fields("OrganizationID") = OrgID
.Fields("Position") = staffTempInfoRS.Fields("StaffPosition")
.Update
End With
Dim currPos As Long
currPos = staffTempInfoRS.Fields("StaffNumber")
StaffID = staffInfoDBRS.LastModified
staffInfoDBRS.Close
Set staffInfoDBRS = Nothing
'staff phone information
Set phoneTempInfoRS = db.OpenRecordset("SELECT * FROM tblTempPhones WHERE StaffNumber = " & currPos & ";")
If Not (phoneTempInfoRS.EOF And phoneTempInfoRS.BOF) Then
phoneTempInfoRS.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until phoneTempInfoRS.EOF = True
Dim phoneInfoDBRS As DAO.Recordset
Set phoneInfoDBRS = db.OpenRecordset("tblStaffPhoneNumbers", dbOpenDynaset)
With phoneInfoDBRS
.AddNew
.Fields("PhoneNumber") = phoneTempInfoRS.Fields("StaffPhoneNumber")
.Fields("PhoneTypeID") = phoneTempInfoRS.Fields("PhoneType")
.Fields("StaffID") = StaffID
.Update
End With
phoneTempInfoRS.MoveNext
Loop
Else
Resume Next
End If
MsgBox "Finished looping through phone records."
phoneTempInfoRS.Close
Set phoneTempInfoRS = Nothing
'Move to the next record. Don't ever forget to do this.
staffTempInfoRS.MoveNext
Loop
Else
MsgBox "There are no records in the staff recordset."
End If
MsgBox "Finished looping through staff records."
staffTempInfoRS.Close 'Close the recordset
Set staffTempInfoRS = Nothing 'Clean up
wrk.CommitTrans
trans_Exit:
'Clean up
wrk.Close
Set db = Nothing
Set wrk = Nothing
Exit Function
trans_Err:
'Roll back the transaction
MsgBox "Whoops! We got errors"
wrk.Rollback
Resume trans_Exit
When I step through this I get an error in this line:
.Fields("StaffStreet") = staffTempInfoRS.Fields("StaffStreet")
That says:
Item not found in collection.
However, this is the exact field name that is in the table that the recordset is set to open.
30 hours later it seems I suffered a rookie mistake and in-spite of repeated checking missed that the field names were indeed misspelled.
I also set the recordsets outside of the loops and I unset them all in the exit snippet...
I keep having issues with this query saying there are no reocrds but I know there are because I am looking at the table. I want to loop through a table to find certain column information based off a few parameters on the click of a button.
So when I click my button it'll loop through table one find the fields I need based on the ID and update the other table with those fields.
Private Sub GetResults_Click()
Dim strSQL As String
Dim SQL As String
Dim dba As Database
Dim tbl As Recordset
Dim rst1 As Recordset
Dim tstdt As Date
tstdt = Me.Date.Value
Set dba = CurrentDb
Set tbl = dba.OpenRecordset("tbl_Results", dbOpenDynaset, dbSeeChanges)
strSQL = "SELECT * FROM tbl_Results"
Set tbl = dba.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
If Not tbl.EOF Then
With tbl
.MoveFirst
Do Until tbl.EOF
Call getDataRecords(tbl!SystemAssignedPersonID, tstdt)
.MoveNext
Loop
End With
End If
Set rst1 = Nothing
Set tbl = Nothing
Set dba = Nothing
End Sub
Function getDataRecords(PersonID As Variant, TestDate As Date)
Dim dba As Database
Dim rst As Recordset
Dim rst1 As Recordset
Dim SQL As String
Set dba = CurrentDb
Set rst = dba.OpenRecordset("tbl_Results", dbOpenDynaset, dbSeeChanges)
Set rst1 = dba.OpenRecordset("dbo_tbl_Random", dbOpenDynaset, dbSeeChanges)
SQL = "SELECT * FROM dbo_tbl_Random WHERE SystemAssignedPersonID = " & PersonID & " AND Date = " & Date & " AND MenuUsed = 'RandomResult'"
Set rst1 = dba.OpenRecordset(SQL, dbOpenDynaset, dbSeeChanges)
rst.AddNew
rst.Fields("FileSent") = rst1!FileSent
rst.Fields("Result") = rst1!Result
rst.Update
End Function
Help before I go nuts! Thanks!
You're over-complicating things here. All this can be done in 1 SQL statement
Update tbl_Results as Res
Inner join dbo_tbl_Random as rand
on Res.PersonID = Rand.SystemAssignedPersonID and Res.[Date] = Rand.[Date]
set Res.FileSent = Rand.FileSent ,
Res.Result = Rand.Result
Where Rand.MenuUsed = 'RandomResult'
You can execute like this
dim sql as string
sql = "Update tbl_Results as Res " & _
"Inner join dbo_tbl_Random as rand " & _
" on Res.PersonID = Rand.SystemAssignedPersonID and Res.[Date] = Rand.[Date] " & _
"set Res.FileSent = Rand.FileSent , " & _
" Res.Result = Rand.Result " & _
" Where Rand.MenuUsed = 'RandomResult' "
CurrentDb.Execute(sql)
Update:
This is how I am expecting your tables are set up
tbl_results
dbo_tbl_Random
How I set up the query in the designer to confirm it is working