Need help with my assignment. I would like to add and delete a record for a selected customer. I can add a new record to the selected customer but when I delete the order it deletes the customer too. I believe it could be the RefreshRecordset call but if I only call orders then I will get everyone's record and not just the selected customer. I'm pretty much stuck on what's wrong with this code.
Private RecCount As Integer
Private CurrentOrderNo As Integer
Private Sub UserForm_Activate()
EnableButtons
CreateDbObjects
With Sheets("Data").cboCustomer
CurrentOrderNo = .List(.ListIndex, 1)
End With
RefreshRecordset CurrentOrderNo
End Sub
Private Sub RefreshRecordset(ByVal ThisCusNo As Integer)
' This routine opens the recordset and selects the
' desired record (based on ThisCusNo)
On Error GoTo error_handle:
sql = "Select * From Customers INNER JOIN Orders ON Orders.CusNo = Customers.CusNo WHERE Orders.CusNo = "& ThisCusNo
rs.Open sql
If rs.BOF And rs.EOF Then 'No customer records, so go into 'Add' mode
RecCount = 0
cmdAdd_Click
Else
rs.MoveLast '<<--This is done to ensure a correct RecordCount in the next line
RecCount = rs.RecordCount
rs.MoveFirst
rs.Find "CusNo = "& ThisCusNo
UpdateTextBoxes
End If
Exit Sub
error_handle:
Select Case Err.Number
Case 91
CreateDbObjects
Resume
Case 3705
rs.Close
Resume
Case Else
MsgBox Err.Number & ": "& Err.Description
End Select
End Sub
Private Sub UpdateTextBoxes()
' This routine is used to place values for the current record into the userform text boxes
If RecCount = 0 Then
Me.Caption = "Order Maintenance - Record 0 of 0"
Else
Me.Caption = "Order Maintenance - Record "& _
rs.AbsolutePosition & " of "& RecCount
lblCustomer = rs.Fields("LName") & ", "& rs.Fields("FName")
txtDate = rs("PurchDate").Value
txtProduct = rs("Product").Value
txtUnits = rs("Units").Value
txtAmount = rs("Amount").Value
lblOrderNo = rs("CusNo").Value
End If
End Sub
Private Sub cmdAdd_Click()
Me.Caption = "Order Maintenance - Add new record..."
Me.Tag = "Add"' Indicates that we're in 'Add' mode
AddChangeClick
End Sub
Private Sub cmdChange_Click()
Me.Caption = "Order Maintenance - Change current record..."
Me.Tag = "Change"' Indicates that we're in 'Change' mode
AddChangeClick
End Sub
Private Sub cmdOK_Click()
' Note: The user can click OK to exit Add/Change mode OR to dismiss the user form
If Me.Tag = "Add" Or Me.Tag = "Change" Then ' User clicked OK while in Add/Change mode
If DataMissing() = True Then
msg = "Required data is missing."& vbCrLf & "Please Try again."
MsgBox msg, vbExclamation, "Error"
Exit Sub
End If
AddOrChangeRecord
Me.Tag = vbOK ' Takes us out of Add/Change mode
EnableButtons
Else ' User clicked OK while not in Add/Chnage mode
Me.Hide
End If
End Sub
Private Function DataMissing() As Boolean
' This routine just checks to see if any TextBoxes are empty
DataMissing = False
For Each ctl In Controls
If TypeName(ctl) = "TextBox" Then
If ctl.Text = "" Then DataMissing = True: Exit Function
End If
Next
End Function
Private Sub AddOrChangeRecord()
Dim rs2 As New ADODB.Recordset
If Me.Tag = "Add" Then
' If we're Adding a record we need a new (unused) value for OrderNo
sql = "Select Max(OrderNo) From Orders"
rs2.Open sql, db, adOpenDynamic, adLockOptimistic
rs.AddNew
rs("CusNo").Value = CurrentCusNo
End If
rs("PurchDate").Value = CStr(txtDate)
rs("Product").Value = CStr(txtProduct)
rs("Units").Value = CStr(txtUnits)
rs("Amount").Value = CStr(txtAmount)
rs("CusNo").Value = CStr(lblOrderNo)
rs.Update
RefreshRecordset CurrentCusNo
End Sub
Private Sub cmdDelete_Click()
Dim rs2 As New ADODB.Recordset
Dim CurrentRecord As Integer
' First see if there are records in the Orders table for this customer
' If so, we don't want to delete the customer record
CusIdNo = rs("CusNo").Value
sql = "Select Count(*) As RecordsLeft From Orders Where CusNo = "& CusIdNo
rs2.Open sql, db, adOpenDynamic, adLockOptimistic
If rs2.Fields("RecordsLeft") < 0 Then
MsgBox "Orders remain for this customer.", vbExclamation, "Cannot Delete..."
Else
msg = "Are you sure you want to delete this record?"
If MsgBox(msg, vbYesNo, "Warning...") = vbYes Then
CurrentRecord = WorksheetFunction.Max(rs.AbsolutePosition - 1, 1)
rs.Delete ' AbsolutePosition is undefined after deleting a record!
RecCount = RecCount - 1
If RecCount = 0 Then
Me.Tag = "Quit"
cmdOK_Click
Else
rs.AbsolutePosition = CurrentRecord
MsgBox "Record deleted.", vbInformation, "Confirmation"
UpdateTextBoxes
End If
End If
End If
End Sub
Private Sub cmdCancel_Click()
' Recall that cmdCancel is only visible in Add/Change mode
If RecCount = 0 Then
Me.Hide
Else
EnableButtons
Me.Tag = vbCancel ' We're no longer in Add/Change mode
UpdateTextBoxes
End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
' This prevents the user from dismissing the form by clicking the close button
Cancel = vbYes
If Me.Tag = "Add" Or Me.Tag = "Change" Then
cmdCancel_Click
Else
cmdOK_Click
End If
End Sub