I have a listbox named listcomponents and each time the user can select multiple values. When the user selects the listbox the Findfirst operation is carried and the Machine System ID and the MachineSubsystem is calculated and based on these two the rs1![Machine Subsystem ID] is obtained. The value obtained in rs1![Machine Subsystem ID] is then again used in the condition for the next list box.
The problem is that the FindFirst operation only checks for the last stored value in rs1![Machine Subsystem ID] and not all the values which get generated (maybe because only the last value is stored in it). So is there a way I can get this to check for all the values that get generated in rs1![Machine Subsystem ID]. Here is the code:
ID = DMax("[MAchine ID]", "tblmachine")
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblMachineSystem", dbOpenDynaset, dbAppendOnly)
Set rs1 = db.OpenRecordset("tblMachineSubSystem", dbOpenDynaset,
dbAppendOnly)
Set rs2 = db.OpenRecordset("tblComponents", dbOpenDynaset, dbAppendOnly)
Set rsmas = db.OpenRecordset("tblMasterData", dbOpenDynaset, dbAppendOnly)
'add selected value(s) to table
Set ctl = Me.listMachineSystem
Set ctl1 = Me.listMachineSubSystem
Set ctl2 = Me.listComponents
For Each varItem In ctl.ItemsSelected
rs.AddNew
rs!MachineSystem = ctl.ItemData(varItem)
rs![MAchine ID] = ID
rs.Update
Next varItem
For i = 0 To Me.listMachineSubSystem.ListCount - 1
If Me.listMachineSubSystem.Selected(i) Then
rs.FindFirst "[Machine ID]=" & ID & " AND [MachineSystem]= '" & DLookup("
[MachineSystem]", "tblMachineSystem", "[Machine System ID]=" &
Me.listMachineSubSystem.Column(2, i)) & "'"
rs1.AddNew
rs1![MachineSubsystem] = Me.listMachineSubSystem.Column(0, i)
rs1![Machine Sytem ID] = rs![Machine System ID]
rs1.Update
End If
Next i
For i = 0 To Me.listComponents.ListCount - 1
If Me.listComponents.Selected(i) Then
rs1.FindFirst "[Machine Sytem ID]=" & rs![Machine System ID] & " AND
[MachineSubsystem]= '" & DLookup("[MachineSubsystem]",
"tblMachineSubSystem",
"[Machine Subsystem ID]=" & Me.listComponents.Column(2, i)) & "'"
If rs1.NoMatch Then
MsgBox "no records found"
Else
Do While Not rs1.NoMatch
MsgBox "i found it!!!"
rs1.FindNext "[Machine Sytem ID]=" & rs![Machine System ID] & "
AND [MachineSubsystem]= '" & DLookup("[MachineSubsystem]",
"tblMachineSubSystem", "[Machine Subsystem ID]=" &
Me.listComponents.Column(2, i)) & "'"
Loop
rs1.FindNext "[Machine Sytem ID]=" & rs![Machine System ID] & " AND
[MachineSubsystem]= '" & DLookup("[MachineSubsystem]",
"tblMachineSubSystem", "[Machine Subsystem ID]=" &
Me.listComponents.Column(2, i)) & "'"
End If
rs2.AddNew
rs2![Components] = Me.listComponents.Column(0, i)
rs2![Machine Subsystem ID] = rs1![Machine Subsystem ID]
rs2.Update
End If
Next i
I have two tables tblmMchineSubSystem with fiels and tblComponents and when the above code runs, I want the Machine Subsystem ID which is the primary key of tblmMchineSubSystem to be populated into the Machine Subsystem ID field of tblComponents. The problem with the above code is that only the last value from the rs![Machine System ID] is checked in the findfirst function. I want all the values in rs![Machine System ID] to be checked by the FindFirst function.
The NEW CODE
ID = DMax("[MAchine ID]", "tblmachine")
Dim sMachineSubsystem As String, varSelectedID11 As Variant
Dim vMaxMachineSubsystemID As Variant
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblMachineSystem", dbOpenDynaset, dbAppendOnly)
Set rs1 = db.OpenRecordset("tblMachineSubSystem", dbOpenDynaset,
dbAppendOnly)
Set rs2 = db.OpenRecordset("tblComponents", dbOpenDynaset, dbAppendOnly)
Set rsmas = db.OpenRecordset("tblMasterData", dbOpenDynaset, dbAppendOnly)
Set ctl = Me.listMachineSystem
Set ctl1 = Me.listMachineSubSystem
Set ctl2 = Me.listComponents
'add selected value(s) from listMachineSystem to tblMachineSystem
For Each varItem In ctl.ItemsSelected
rs.AddNew
rs!MachineSystem = ctl.ItemData(varItem)
rs![MAchine ID] = ID
rs.Update
Next varItem
For i = 0 To Me.listMachineSubSystem.ListCount - 1
If Me.listMachineSubSystem.Selected(i) Then
rs.FindFirst "[Machine ID]=" & ID & " AND [MachineSystem]= '" & DLookup("
[MachineSystem]", "tblMachineSystem", "[Machine System ID]=" &
Me.listMachineSubSystem.Column(2, i)) & "'"
rs1.AddNew
rs1![MachineSubsystem] = Me.listMachineSubSystem.Column(0, i)
rs1![Machine Sytem ID] = rs![Machine System ID]
rs1.Update
'Grab the maximum Machine System ID for the last selected item in the
listMachineSubSystem list, for use in the next section
'To add components for every item selected in listMachineSubSystem, move the
entire below section of code to inside the previous section (so it's a loop
within a loop... be sure to rename i to something else)
vMaxMachineSubsystemID = DMax("[Machine System ID]", "tblMachineSystem", "
[Machine ID]=" & ID & " AND [MachineSystem]= '" & DLookup("
[MachineSystem]",
"tblMachineSystem", "[Machine System ID]=" & rs![Machine System ID]) & "'")
'add selected value(s) from listComponents to tblComponents
For l = 0 To Me.listComponents.ListCount - 1
If Me.listComponents.Selected(l) Then
varSelectedID2 = Me.listComponents.Column(2, l)
sMachineSubsystem = DLookup("[MachineSubsystem]",
"tblMachineSubSystem", "[Machine Subsystem ID]=" & varSelectedID2)
rs1.FindFirst "[Machine Sytem ID]=" & vMaxMachineSubsystemID & " AND
[MachineSubsystem]= '" & sMachineSubsystem & "'"
If rs1.NoMatch Then
MsgBox "no records found"
Else
Do While Not rs1.NoMatch
MsgBox "I found it!!!"
rs2.AddNew
rs2![Components] = Me.listComponents.Column(0, l)
rs2![Machine Subsystem ID] = rs1![Machine Subsystem ID]
rs2.Update
rs1.FindNext "[Machine Sytem ID]=" & vMaxMachineSubsystemID & "
AND [MachineSubsystem]= '" & sMachineSubsystem & "'"
Loop
End If
End If
Next l
End If
Next i
I'm assuming you set rs (without 1 or 2) to something earlier?
This seems very convoluted, and would result in a lot of unnecessary work for the machine. I'd add a TransactionID to the tblMachineSubSystem table, and then do something like:
dim MachineSystemID as variant, iMaxTransactionID as integer, iNewTransactionID as integer
Set rs1 = db.OpenRecordset("SELECT * FROM tblMachineSubSystem WHERE [Machine Sytem ID] = 1", dbOpenDynaset, dbAppendOnly) 'Saves time when all you want to do is add to the table
For i = 0 To Me.listMachineSubSystem.ListCount - 1
If Me.listMachineSubSystem.Selected(i) Then
MachineSystemID = DLookup("[Machine System ID]", "tblMachineSystem", "[Machine System ID]=" & Me.listMachineSubSystem.Column(2, i))
iMaxTransactionID = DMax("[TransactionID]", "tblMachineSystem") 'Note that this logic assumes a single-user database, so there aren't multiple transactions going on at the same time
rs1.AddNew
rs1![MachineSubsystem] = Me.listMachineSubSystem.Column(0, i)
rs1![Machine Sytem ID] = rs![Machine System ID]
iNewTransactionID = iMaxTransactionID + 1
rs1![TransactionID] = iNewTransactionID
rs1.Update
End If
Next i
rs1.Close
docmd.runsql "INSERT INTO tblComponents (Components, [Machine Subsystem ID]) SELECT MachineSubsystem, [Machine Subsystem ID] FROM tblMachineSubSystem WHERE TransactionID = " & iNewTransactionID
EDIT: Ok, here's the new version:
ID = DMax("[MAchine ID]", "tblmachine")
dim sMachineSubsystem as string, varSelectedID11 as variant
dim vMaxMachineSubsystemID as variant
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblMachineSystem", dbOpenDynaset, dbAppendOnly)
Set rs1 = db.OpenRecordset("tblMachineSubSystem", dbOpenDynaset,
dbAppendOnly)
Set rs2 = db.OpenRecordset("tblComponents", dbOpenDynaset, dbAppendOnly)
Set rsmas = db.OpenRecordset("tblMasterData", dbOpenDynaset, dbAppendOnly)
Set ctl = Me.listMachineSystem
Set ctl1 = Me.listMachineSubSystem
Set ctl2 = Me.listComponents
'add selected value(s) from listMachineSystem to tblMachineSystem
For Each varItem In ctl.ItemsSelected
rs.AddNew
rs!MachineSystem = ctl.ItemData(varItem)
rs![MAchine ID] = ID
rs.Update
Next varItem
'add selected value(s) from listMachineSubSystem to tblMachineSubSystem
For i = 0 To Me.listMachineSubSystem.ListCount - 1
If Me.listMachineSubSystem.Selected(i) Then
varSelectedID1 = Me.listMachineSubSystem.Column(2, i)
sMachineSubsystem = Me.listMachineSubSystem.Column(0, i)
rs1.AddNew
rs1![MachineSubsystem] = sMachineSubsystem
rs1![Machine Sytem ID] = varSelectedID1
rs1.Update
End If
Next i
'Grab the maximum Machine System ID for the last selected item in the listMachineSubSystem list, for use in the next section
'To add components for every item selected in listMachineSubSystem, move the entire below section of code to inside the previous section (so it's a loop within a loop... be sure to rename i to something else)
vMaxMachineSubsystemID = DMax("[Machine System ID]", "tblMachineSystem", "[Machine ID]=" & ID & " AND [MachineSystem]= '" & DLookup("[MachineSystem]", "tblMachineSystem", "[Machine System ID]=" & varSelectedID1) & "'")
'add selected value(s) from listComponents to tblComponents
For i = 0 To Me.listComponents.ListCount - 1
If Me.listComponents.Selected(i) Then
varSelectedID2 = Me.listComponents.Column(2, i)
sMachineSubsystem = DLookup("[MachineSubsystem]", "tblMachineSubSystem", "[Machine Subsystem ID]=" & varSelectedID2)
rs1.FindFirst "[Machine Sytem ID]=" & vMaxMachineSubsystemID & " AND [MachineSubsystem]= '" & sMachineSubsystem & "'"
If rs1.NoMatch Then
MsgBox "no records found"
Else
Do While Not rs1.NoMatch
MsgBox "I found it!!!"
rs2.AddNew
rs2![Components] = Me.listComponents.Column(0, i)
rs2![Machine Subsystem ID] = rs1![Machine Subsystem ID]
rs2.Update
rs1.FindNext "[Machine Sytem ID]=" & vMaxMachineSubsystemID & " AND [MachineSubsystem]= '" & sMachineSubsystem & "'"
Loop
End If
End If
Next i
Related
I've written a function to loop through an array of a custom object (C_Document). In the loop, if the document number does not already exist, it should insert a new record into the table tbl_docs. If the document does exist, it should update the appropriate record in the database.
Public Function updateDocuments(docs() As C_Document) As Double
Dim db As Object
Set db = Application.CurrentDb
Dim docIndex As Double
'Loop through all imported documents
For docIndex = 1 To UBound(docs)
Dim strSQL As String
Dim exists As Double
exists = DCount("docNo", "tbl_docs", "docNo = '" & docs(docIndex).getDocNo() & "'" > 0)
'Check if entry already exists
If (exists > 0) Then
'docNo entry already exists - update
strSQL = "UPDATE tbl_docs SET " & _
"docReviewStatus = " & docs(docIndex).getDocStatus() & "," & _
"docRev = '" & docs(docIndex).getDocReview() & "'," & _
"docDate = '" & docs(docIndex).getDocDate() & "'" & _
" WHERE (" & _
"docNo = '" & docs(docIndex).getDocNo() & "');"
Else
'docNo does not exist - insert
strSQL = "INSERT INTO tbl_docs (docNo, docReviewStatus, docRev, docDate) " & _
"SELECT '" & docs(docIndex).getDocNo() & "'" & _
"," & docs(docIndex).getDocStatus() & _
",'" & docs(docIndex).getDocReview() & "'" & _
",'" & docs(docIndex).getDocDate() & "'" & _
";"
End If
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
MsgBox strSQL
Next
updateDocuments = docIndex
End Function
However, when the function is called (with tbl_docs empty), it only inserts one record and the SQL string thereafter becomes the update statement.
Is there a common issue when DCount() is used in a loop? Does anyone have any experience with this logical error?
Your check has a slight but important error:
exists = DCount("docNo", "tbl_docs", "docNo = '" & docs(docIndex).getDocNo() & "'" > 0)
should be
exists = DCount("docNo", "tbl_docs", "docNo = '" & docs(docIndex).getDocNo() & "'") > 0
or if exists isn't bool, but simply the count, then
exists = DCount("docNo", "tbl_docs", "docNo = '" & docs(docIndex).getDocNo() & "'")
You can simplify and speed up this a bit using DAO, where you can do the search and update/edit in one go:
Public Function updateDocuments(docs() As C_Document) As Long
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim docIndex As Long
Dim strSQL As String
strSQL = "Select * From tbl_docs"
Set db = Application.CurrentDb
Set rs = db.OpenRecordset(strSQL)
'Loop through all imported documents
For docIndex = LBound(docs) To UBound(docs)
rs.FindFirst "docNo = '" & docs(docIndex).getDocNo() & "'"
If rs.NoMatch Then
'docNo does not exist - insert
rs.AddNew
rs!docNo.Value = docs(docIndex).getDocNo()
Else
'docNo entry already exists - update
rs.Edit
End If
rs!docReviewStatus.Value = docs(docIndex).getDocStatus()
rs!docRev.Value = docs(docIndex).getDocReview()
rs!docDate = docs(docIndex).getDocDate()
rs.Update
Next
rs.Close
updateDocuments = docIndex
End Function
i have 4 listboxes named listMachine, listMachineSystem,listMachineSubSystem and listcompoenents. The user selects the items the from the list boxes as he wishes and the tables are populated along with the ID from the previuos table to the new table since all the listboxes are connected hierarchially. The problem is that in the tblcomponents the seleted items get popileuted in a loop over and over agao an i dont how to stop this . I have attahced the code below . Can anyone help me out on this.
ID = DMax("[MAchine ID]", "tblmachine")
Dim sMachineSubsystem As String, varSelectedID11 As Variant
Dim vMaxMachineSubsystemID As Variant
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblMachineSystem", dbOpenDynaset, dbAppendOnly)
Set rs1 = db.OpenRecordset("tblMachineSubSystem", dbOpenDynaset, dbAppendOnly)
Set rs2 = db.OpenRecordset("tblComponents", dbOpenDynaset, dbAppendOnly)
For n = 0 To Me.listMachineSystem.ListCount - 1
If Me.listMachineSystem.Selected(n) Then
rs.AddNew
rs!MachineSystem = Me.listMachineSystem.Column(0, n)
rs![MAchine ID] = ID
rs!MO_TAG = Me.listMachineSystem.Column(3, n)
rs!MachineSystem_Details = Me.listMachineSystem.Column(4, n)
rs.Update
End If
Next n
For i = 0 To Me.listMachineSubSystem.ListCount - 1
If Me.listMachineSubSystem.Selected(i) Then
rs.FindFirst "[Machine ID]=" & ID & " AND [MachineSystem]= '" &
DLookup ("[MachineSystem]", "tblMachineSystem",
"[Machine System ID]=" & Me.listMachineSubSystem.Column(2, i)) & "'"
rs1.AddNew
rs1![MachineSubsystem] = Me.listMachineSubSystem.Column(0, i)
rs1![Machine Sytem ID] = rs![Machine System ID]
rs1![MO_TAG] = Me.listMachineSubSystem.Column(3, i)
rs1![MachineSubSystem_Details] = Me.listMachineSubSystem.Column(4, i)
rs1.Update
'add selected value(s) from listComponents to tblComponents
For l = 0 To Me.listComponents.ListCount - 1
If Me.listComponents.Selected(l) Then
varSelectedID2 = Me.listComponents.Column(2, l)
sMachineSubsystem = DLookup("[MachineSubsystem]", "tblMachineSubSystem",
"[Machine Subsystem ID]=" & varSelectedID2)
vMaxMachineSubsystemID = DMax("[Machine System ID]", "tblMachineSystem",
"[Machine ID]=" & ID & " AND [MachineSystem]= '" &
DLookup("[MachineSystem]", "tblMachineSystem", "[Machine System ID]="
& rs![Machine System ID]) & "'")
rs1.FindFirst "[Machine Sytem ID]=" & vMaxMachineSubsystemID & "
AND [MachineSubsystem]= '" & sMachineSubsystem & "'"
If rs1.NoMatch Then
MsgBox "no records found"
Else
Do While Not rs1.NoMatch
MsgBox "I found it!!!"
rs2.AddNew
rs2![Components] = Me.listComponents.Column(0, l)
rs2![Machine Subsystem ID] = rs1![Machine Subsystem ID]
rs2![MO_TAG] = Me.listComponents.Column(3, l)
rs2![Components_Detail] = Me.listComponents.Column(4, l)
rs2.Update
rs1.FindNext "[Machine Sytem ID]=" & vMaxMachineSubsystemID & "
AND [MachineSubsystem]= '" & sMachineSubsystem & "'"
Loop
End If
End If
Next l
End If
Next i
I have a query table and transfer to excel. I loop from cell range to re-query into database and it works fine but it really take so much time since i used below code.. The code need to query and do recordset every time satified IF condition in each single cell. Is there other way that this code will execute in database server and once complete then, only do a recordset?
'Set Connection
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Driver={MySQL ODBC 5.3 ANSI Driver};Server=" & _
Server_Name & ";Port=" & Port & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
'Set Recordset
Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = 3
rs.Open SQLQuery, Cn, adOpenStatic
myArray = rs.GetRows()
kolumner = UBound(myArray, 1) 'Count number of Columns
rader = UBound(myArray, 2) 'count number of rows
For K = 0 To kolumner ' Using For loop data are displayed
Range("A5").Offset(0, K).Value = rs.Fields(K).Name 'Field is the header
of each column and not included in Array. Field(0) means header of first
column.
For R = 0 To rader
Range("A5").Offset(R + 1, K).Value = myArray(K, R)
Next
Next
set rows = 0 to rader
Range("L5").Value = "Debug Note" 'insert Name of Column
For R = 6 To 1100
Datevalue = Sheets("Sheet1").Range("I" & R)
Dateexcel = FORMAT(Datevalue, "yyyy-MM-dd HH:mm:ss")
SQLQuery2 = "SELECT * FROM Mfg.databasemodels_note " & _
"where typeId = " & Sheets("Sheet1").Range("B" & R) & " AND
date > " & "'" & Dateexcel & "'" & " order by date asc
limit 1;"
Set rs2 = CreateObject("ADODB.Recordset")
rs2.CursorLocation = 3 'client
rs2.Open SQLQuery2, Cn, adOpenStatic
myArray2 = rs2.GetRows()
If Not (rs2.BOF And rs2.EOF) And (Range("J" & R).Value = "failed" Or
Range("J" & R).Value = "invalid") Then
Range("L" & R).Value = myArray2(3, 0)
Else
End If
On Error Resume Next
rs2.Close
Set rs2 = Nothing
Next
Context:
I made a Vacation tracking module in my database. The employees can request advanced hours take off in a current year period and it will be deducted from their next years period.
The Case:
I am trying to make a continuous loop through the recordset of employees to see if they have been awarded advanced hours and if yes add it to the vacation hours they have.
The Problem:
I have the logic down but I can't get it to loop through each employee on my continuous form.
With Me.RecordsetClone
While Not .EOF
adv = DLookup("advhours", "dbo_employees", "[empid] = txtempid")
vac = DLookup("vhrs", "dbo_employees", "[empid] = txtempid")
adate = DLookup("advdate", "dbo_employees", "[empid] = txtempid")
andatestart = DLookup("anndate", "dbo_employees", "[empid] = txtempid")
andateend = DateAdd("yyyy", AgeSimple([andatestart]), [andatestart])
anddateend = DateAdd("yyyy", 1, andateend)
morehours = DLookup("totalvachrs", "dbo_employees", "[empid] = txtempid")
sum = adv + vac
If adv > 0 And adate > DateAdd("yyyy", AgeSimple([andatestart]), [andatestart]) And adate < anddateend And morehours = 0 Then
morehours = 1
' sets the flag to 1 if true.
DoCmd.RunSQL "UPDATE dbo_employees " & "SET dbo_employees.totalvachrs='" & morehours & "' " & "WHERE dbo_employees.empid=" & txtempid & ";"
'increment vacation hours
DoCmd.RunSQL "UPDATE dbo_employees " & "SET dbo_employees.vhrs='" & sum & "' " & "WHERE dbo_employees.empid=" & txtempid & ";"
End If
'after Vac hours have been updated..
If morehours = 1 And adate < andateend Then
' puts vacation hours back down to where they were.
vac = vac - adv
DoCmd.RunSQL "UPDATE dbo_employees " & _
"SET dbo_employees.vhrs='" & _
vac & "' " & _
"WHERE dbo_employees.empid=" & txtempid & ";"
adv = 0
DoCmd.RunSQL "UPDATE dbo_employees " & _
"SET dbo_employees.advhours='" & _
adv & "' " & _
"WHERE dbo_employees.empid=" & txtempid & ";"
morehours = 0
DoCmd.RunSQL "UPDATE dbo_employees " & _
"SET dbo_employees.totalvachrs='" & _
morehours & "' " & _
"WHERE dbo_employees.empid=" & txtempid & ";"
End If
Debug.Print txtempid ' CTRL G to see
If Not .EOF Then .MoveNext
Wend
End With
MsgBox "after loop: " & txtempid
I have also tried this as well, but i get drop changes dialogue in access
Set rs = Me.RecordsetClone
rs.MoveFirst
Do While Not rs.EOF
Me.Bookmark = rs.Bookmark
adv = DLookup("advhours", "dbo_employees", "[empid] = txtempid")
vac = DLookup("vhrs", "dbo_employees", "[empid] = txtempid")
adate = DLookup("advdate", "dbo_employees", "[empid] = txtempid")
andatestart = DLookup("anndate", "dbo_employees", "[empid] = txtempid")
andateend = DateAdd("yyyy", AgeSimple([andatestart]), [andatestart])
anddateend = DateAdd("yyyy", 1, andateend)
morehours = DLookup("totalvachrs", "dbo_employees", "[empid] = txtempid")
sum = adv + vac
If adv > 0 And adate > DateAdd("yyyy", AgeSimple([andatestart]), [andatestart]) And adate < anddateend And morehours = 0 Then
morehours = 1
DoCmd.RunSQL "UPDATE dbo_employees " & "SET dbo_employees.totalvachrs='" & morehours & "' " & "WHERE dbo_employees.empid=" & txtempid & ";"
DoCmd.RunSQL "UPDATE dbo_employees " & "SET dbo_employees.vhrs='" & sum & "' " & "WHERE dbo_employees.empid=" & txtempid & ";"
End If
If morehours = 1 And adate < andateend Then
vac = vac - adv
DoCmd.RunSQL "UPDATE dbo_employees " & _
"SET dbo_employees.vhrs='" & _
vac & "' " & _
"WHERE dbo_employees.empid=" & txtempid & ";"
adv = 0
DoCmd.RunSQL "UPDATE dbo_employees " & _
"SET dbo_employees.advhours='" & _
adv & "' " & _
"WHERE dbo_employees.empid=" & txtempid & ";"
morehours = 0
DoCmd.RunSQL "UPDATE dbo_employees " & _
"SET dbo_employees.totalvachrs='" & _
morehours & "' " & _
"WHERE dbo_employees.empid=" & txtempid & ";"
End If
Me.Bookmark = rs.Bookmark
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
DotyDot,
I think that your problem is a basic misunderstanding of how recordsets and forms (and continuous forms) work.
Regardless of whether the form is a regular form (one record displayed at a time) or a continuous form (multiple records displayed at a time), the ability and limitations in referencing values (fields) on the form and/or use the recordset does not change.
You can't "loop" through a continuous form in code and reference the controls on the form (txtempid) and get the value from each record, as you are trying to do.
Anytime you reference a control on a form, you will only get the value for that control associated with the current record.
Looping through a recordset, even if you instantiate the recordset from the form recordsetclone, will NOT change the current record pointer on the form.
Your second code example is closest to something that will work, but still needs some work. First, when working with a recordset in code, you will most likely NOT reference the form controls, you will reference the field values directly from the recordset. I don't know your table structure, but here is an example that should get you on the right track.
I assume that this code will run on a button click, or some other event where you are wanting to evaluate all employees.
Dim rst as DAO.Recordset
Set rst = Me.RecordsetClone
Do While Not rst.EOF
adv = DLookup("advhours", "dbo_employees", "[empid] = " & rst("empid"))
vac = DLookup("vhrs", "dbo_employees", "[empid] = " & rst("empid"))
adate = DLookup("advdate", "dbo_employees", "[empid] = " & rst("empid"))
andatestart = DLookup("anndate", "dbo_employees", "[empid] = " & rst("empid"))
andateend = DateAdd("yyyy", AgeSimple(rst("andatestart")), rst("andatestart"))
anddateend = DateAdd("yyyy", 1, rst("andateend"))
morehours = DLookup("totalvachrs", "dbo_employees", "[empid] = " & rst("empid"))
sum = adv + vac
If adv > 0 And adate > DateAdd("yyyy", AgeSimple(rst("andatestart")), rst("andatestart")) And adate < anddateend And morehours = 0 Then
morehours = 1
rst.Edit
rst("totalvachrs") = morehours
rst("vhrs") = sum
rst.Update
End If
If morehours = 1 And adate < andateend Then
vac = vac - adv
rst.Edit
rst("vhrs") = vac
adv = 0
rst("advhours") = adv
morehours = 0
rst("totalvachrs") = morehours
rst.Update
End If
rst.MoveNext
Loop
Set rst = Nothing
'Refresh the screen
Me.Requery
You don't need to use DoCmd.RunSQL, you can edit the data directly in the Recordset via code.
Please note that in your example code, anyplace where you appeared to be referencing a control on the form
[andatestart]
I changed it to reference that field name in the recordset
rst("andatestart")
This code will loop through every record on your form and perform the calculations and updates you were doing.
FYI, in your original code, by setting the form bookmark (Me.Bookmark)
to the recordset Bookmark, you were forcing the form to move the
current record pointer through each record, but that is really not the
best way to accomplish what you are trying to do, IMO
I hope this helps.
I have this code:
If Len(Me.Text9.Value & vbNullString) = 0 Then
sSQL = "SELECT [Ra 1080] as [civil] FROM civil where main=" & Forms![PDS Main Form]![Main Table ID] & " ORDER BY ID"
Set rs = db.OpenRecordset(sSQL)
rs.MoveFirst
Do Until rs.EOF
Text9.Value = Text9.Value + rs!civil + ", "
rs.MoveNext
Loop
Set rs = Nothing
End If
If you run the query it would return 3 records cs1.5,cs1.3,cs1.9
running the code the textbox would only return cs 1.3, cs 1.9,
Not sure using MoveFirst would have caused the trouble, try this code. See if it works.
If Len(Me.Text9.Value & vbNullString) = 0 Then
sSQL = "SELECT [Ra 1080] As [civil] FROM civil WHERE main = " & _
Forms![PDS Main Form]![Main Table ID] & " ORDER BY ID"
Set rs = db.OpenRecordset(sSQL)
Do While Not rs.EOF
Text9.Value = Text9.Value & rs!civil & ", "
rs.MoveNext
Loop
Set rs = Nothing
End If
Just taken away the .MoveFirst and few other simple modifications.