Updating multiple tables with one form using VBA on Microsoft Access - vba

I am trying to add a record on the main table whenever I click submit and one field from this table will go to another one of two tables as a new row based on whether i check a checkbox. For some reason, the record only goes into the main table and neither of the other two. Here's my code.
Private Sub Submit_Click()
Dim SqlString As String
Dim rs As DAO.Recordset
Dim req As Integer
SqlString = "SELECT * FROM [WorkRecord]"
SqlString1 = "SELECT * FROM [MainWork]"
sqlString2 = "SELECT * FROM [MiscelleneousWork]"
Set db = CurrentDb
Set rs = db.OpenRecordset(SqlString)
rs.MoveLast
lastnum = rs!WorkNum
rs.AddNew
rs!WorkNum = lastnum + 1
rs!WorkDate = Me.WorkDate.Value
rs!ReqNum = Me.ReqNum.Value
rs.Update
If Me.checkmain.Value = True Then
Set rs1 = db.OpenRecordset(SqlString1)
rs1.MoveLast
lastnum = rs!WorkNum
rs1.AddNew
rs1!WorkNum = lastnum + 1
rs1.Update
rs1.Close
Else
Set rs2 = db.OpenRecordset(sqlString2)
rs2.MoveLast
lastnum = rs!WorkNum
rs2.AddNew
rs2!WorkNum = lastnum + 1
rs2.Update
rs2.Close
End If
MsgBox ("Work added.")
DoCmd.Close acForm, "AddWorkRecord"
rs.Close
End Sub

Related

Allow data to delete from one table to add to another table

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

not able to edit record by passing text value through form access 2007

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

How do I loop using multiple conditions for a submit button?

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.

Access Vba Sequence ID from other Table

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

DLOOKUP from a query on current recordset

I am trying to do a dlookup where the criteria should be the current recordset and the textbox number (eg text13) should update to the next textbox number (eg text14):
'Count MasterList Items
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsCount As Integer
Dim queryNameOrSQL As String
queryNameOrSQL = "qryMasterList"
Set db = CurrentDb
Set rs = db.OpenRecordset(queryNameOrSQL)
rsCount = rs.RecordCount
i = 1
textBoxIndex = 13
Do While i <= rsCount
Me.Text & textBoxIndex = DLookup("[Item]", "MasterList", "WHERE RECORDSET = " & i)
i = i + 1
textBoxIndex = textBoxIndex + 1
Loop
There is no need to count the records - just loop along:
Const textBoxIndex As Long = 12
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim queryNameOrSQL As String
Dim recorditem As Long
queryNameOrSQL = "qryMasterList"
Set db = CurrentDb
Set rs = db.OpenRecordset(queryNameOrSQL)
While Not rs.EOF
recorditem = recorditem + 1
Me("Text" & CStr(textBoxIndex + recorditem) & "").Value = DLookup("[Item]", "MasterList", "WHERE RECORDSET = " & recorditem & "")
rs.MoveNext
Wend
rs.Close