Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88854

Add/Delete a record in Access using Excel

$
0
0

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.

enter image description here

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

Viewing all articles
Browse latest Browse all 88854

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>