VBA Code Review

Status
Not open for further replies.
N

ne1wantaride

[H]ard|Gawd
Joined
Feb 8, 2003
Messages
1,413
What is throwing an error 94 Invalid use of null on this code? It is a form that we have developed that is inventory maintenance for a table that get's it's values from an inventory input form.

Code: 
Option Compare Database
Option Explicit

Const strConfirmAddMFG As String = "It looks like you've entered a new Manufacturer.  Do you want to add it to the database?"
Const strUnsuccessfulMFGAdd As String = "Error encountered when adding manufacturer database.  The item was not successfully added."

'This keeps track of whether we're editing or adding a new record
Dim UpdateMode As Boolean
Dim StoreItemNumber As Integer
Dim StoreQBNumber As String
Dim StoreMFG As Integer
Dim StoreModel As String
Dim StoreModelNumber As String
Dim StoreCategory As Integer
Dim StoreUnique As Boolean
Dim StorePhysical As Boolean

Private Sub cboAddCat_AfterUpdate()
    cboAddSubCat.Requery
    
    'Check if item is on the new list
    Dim ItemOnList As Boolean
    Dim x As Integer
    For x = 0 To cboAddSubCat.ListCount - 1
        If cboAddSubCat.Column(1, x) = cboAddSubCat.Value Then
            ItemOnList = True
            Exit For
        End If
    Next x
        
    'If the item isn't on the list, clear it
    If Not ItemOnList Then
        cboAddSubCat.Value = ""
    End If
End Sub

Private Sub cboAddID_AfterUpdate()
    'First, take care of the existing record if it's been edited
    If UpdateMode And EditRecordChanged Then
           
        'Check if the user wants to save those changes
        Dim result As VbMsgBoxResult
        result = MsgBox("It looks like you edited the last record--do you want to save those edits?", vbYesNoCancel)
        
        'Cancelling reverts the order number and allows the user to keep editing the old record.
        If result = vbCancel Then
            cboAddID.Value = StoreItemNumber
            Exit Sub
        End If
        
        'Saying yes updates the record and sets up for a new record
        If result = vbYes And RequiredValuesPresent Then
            UpdateItemFromComponents StoreItemNumber
        End If
    End If
    
    If Nz(cboAddID.Value, "") <> "" Then   'If a new order is selected
        UpdateMode = True                        'Change to edit mode.
        cmdAdd.Caption = "&Edit Item"            'Update the button to show that we're now in edit mode
        PopulateStoreVarsFromID cboAddID.Value   'Either way, store values to check if they've changed later
        PopulateComponentsFromStoredVars         'Update all the components with the new data, using our stored values to avoid rerunning the queries
    Else                                   'Otherwise, if it's blank, we're making a new record
        UpdateMode = False                       'Turn off updatemode
        cmdAdd.Caption = "&Add Item"             'Update the button to show that we're now in edit mode
        SetComponentsAndStoreVarsToBlank         'Then reset the components
    End If
    
    'Whatever happens...
    lstItems.Requery
End Sub

Public Sub PopulateComponentsFromStoredVars()
    txtAddQB.Value = StoreQBNumber
    cboAddMFG.Value = DLookup("MFG", "MFGList", "ID=" & StoreMFG)
    txtAddModel.Value = StoreModel
    txtAddModelNumber.Value = StoreModelNumber
    cboAddCat.Value = DLookup("Category", "Categories", "ID=" & StoreCategory)
    cboAddSubCat.Value = DLookup("SubCategory", "Categories", "ID=" & StoreCategory)
    chkAddUnique.Value = StoreUnique
    chkAddPhysical.Value = StorePhysical
End Sub

Public Sub PopulateStoreVarsFromID(ID As Integer)
    StoreQBNumber = DLookup("QBItemNumber", "Items", "ID=" & ID)
    StoreMFG = DLookup("Manufacturer", "Items", "ID=" & ID)
    StoreModel = DLookup("Model", "Items", "ID=" & ID)
    StoreModelNumber = DLookup("ModelNumber", "Items", "ID=" & ID)
    StoreCategory = DLookup("Category", "Items", "ID=" & ID)
    StoreUnique = DLookup("HasUniqueID", "Items", "ID=" & ID)
    StorePhysical = DLookup("IsPhysical", "Items", "ID=" & ID)
    StoreItemNumber = ID
End Sub

Public Sub SetComponentsAndStoreVarsToBlank()
    txtAddQB.Value = ""
    cboAddMFG.Value = ""
    txtAddModel.Value = ""
    txtAddModelNumber.Value = ""
    cboAddCat.Value = ""
    cboAddSubCat.Value = ""
    chkAddUnique.Value = ""
    chkAddPhysical.Value = ""
    StoreQBNumber = ""
    StoreMFG = 0
    StoreModel = ""
    StoreModelNumber = ""
    StoreCategory = 0
    StoreUnique = False
    StorePhysical = False
    StoreItemNumber = 0
End Sub

Private Sub UpdateItemFromComponents(ItemNumber As Integer)
    Dim sSql As String
    sSql = "UPDATE Items SET " & _
           "QBItemNumber='" & txtAddQB.Value & "', " & _
           "Manufacturer=" & GetMFGIDFromForm & ", " & _
           "Model='" & txtAddModel.Value & "', " & _
           "ModelNumber='" & txtAddModelNumber.Value & "', " & _
           "HasUniqueID=" & chkAddUnique.Value & ", " & _
           "IsPhysical=" & chkAddPhysical.Value & ", " & _
           "Category=" & GetCatIDFromForm & " " & _
           "WHERE ID=" & ItemNumber & ";"
    DoCmd.RunSQL sSql
End Sub

Private Function EditRecordChanged() As Boolean
    Dim Changed As Boolean
    Changed = False
    
    'QB Number
    If txtAddQB.Value <> StoreQBNumber Then
        Changed = True
    End If
    
    'Manufacturer
    If cboAddMFG.Value <> DLookup("MFG", "MFGList", "ID=" & StoreMFG) Then
        Changed = True
    End If
    
    'Model
    If txtAddModel.Value <> StoreModel Then
        Changed = True
    End If
    
    'Model Number
    If txtAddModelNumber.Value <> StoreModelNumber Then
        Changed = True
    End If
    
    'Category
    If GetCatIDFromForm <> StoreCategory Then
        Changed = True
    End If
    
    'Unique
    If chkAddUnique.Value <> StoreUnique Then
        Changed = True
    End If
    
    'Physical
    If chkAddPhysical.Value <> StorePhysical Then
        Changed = True
    End If
    
    'Report back if any of the items have changed
    EditRecordChanged = Changed
End Function

Private Sub cmdAdd_Click()
    'If we were editing a record before,
    If UpdateMode Then
        'And if there were changes,
        If EditRecordChanged Then
            
            'Check if the user wants to save those changes
            Dim result As VbMsgBoxResult
            result = MsgBox("Are you sure you want to edit this record?", vbYesNo)
            
            'Cancelling stops the process
            If result = vbNo Then
                Exit Sub
            End If
            
            'Saying yes updates the record and stores the new values
            UpdateItemFromComponents StoreItemNumber
            PopulateStoreVarsFromID cboAddID.Value
        End If
        
    'Otherwise, if we're adding a new record, check to make sure all the data is there.
    Else
        If RequiredValuesPresent Then
            'Add a new record
            AddItemWithCat Nz(txtAddQB.Value, ""), cboAddMFG.Value, txtAddModel.Value, txtAddModelNumber.Value, _
                              chkAddUnique.Value, chkAddPhysical.Value, GetCatIDFromForm
            lstItems.Requery
            cmdAddClear_Click
        End If
    End If
End Sub

Public Function RequiredValuesPresent() As Boolean
    'Check for a valid MFG
    If Nz(cboAddMFG.Value, "") = "" Then
        MsgBox "Manufacturer is a required field."
        RequiredValuesPresent = False
        Exit Function
    Else
        'if the MFG isn't already on the MFG list,
        If DCount("MFG", "MFGList", "MFG='" & cboAddMFG.Value & "'") < 1 Then
            'Then ask the user if they want to add it.  If so,
            If MsgBox(strConfirmAddMFG, vbYesNoCancel) = vbYes Then
               'Add the item to the database.  Return an error if unsuccessful.
               If AddMFG(cboAddMFG.Value) = False Then
                  MsgBox strUnsuccessfulMFGAdd
                  RequiredValuesPresent = False
                  Exit Function
               'Otherwise, repopulate the MFG combo boxes and move forward with the record add.
               Else
                  cboAddMFG.Requery
               End If
            'If the user doesn't want to add the MFG,
            Else
                'Then the user isn't ready to add a record.
                Exit Function
            End If
        End If
    End If
    
    'Check for a valid Model
    If txtAddModel.Value = "" Then
        MsgBox "Model is a required field."
        RequiredValuesPresent = False
        Exit Function
    End If

    'Check for a valid Model number
    If txtAddModelNumber.Value = "" Then
        MsgBox "Model Number is a required field."
        RequiredValuesPresent = False
        Exit Function
    End If
    
    'Check for a valid Physical Marker
    If IsNull(chkAddPhysical.Value) Then
        MsgBox "Is Physical is a required field."
        RequiredValuesPresent = False
        Exit Function
    End If
    
    'Check for a valid Unique Marker
    If IsNull(chkAddUnique.Value) Then
        MsgBox "Is Unique is a required field."
        RequiredValuesPresent = False
        Exit Function
    End If

    'Check for a valid Category
    If cboAddCat.Value = "" Then
        MsgBox "Category is a required field."
        RequiredValuesPresent = False
        Exit Function
    End If
    
    'Check for a valid Sub Category
    If cboAddSubCat.Value = "" Then
        MsgBox "Sub Category is a required field."
        RequiredValuesPresent = False
        Exit Function
    End If
    
    'If the function gets this far...
    RequiredValuesPresent = True
End Function

Public Function GetCatIDFromForm() As Integer
    If cboAddCat.Value = "" Or cboAddSubCat.Value = "" Then
        GetCatIDFromForm = 0
    Else
        GetCatIDFromForm = DLookup("ID", "Categories", "Category='" & cboAddCat.Value & "' AND SubCategory='" & cboAddSubCat.Value & "'")
    End If
        
End Function

Public Function GetMFGIDFromForm() As Integer
    GetMFGIDFromForm = DLookup("ID", "MFGList", "MFG='" & cboAddMFG.Value & "'")
End Function

Private Sub cmdAddClear_Click()
    'Clear ID component
    cboAddID.Value = ""
    
    'Run update procedure to make sure we save edits if necessary
    cboAddID_AfterUpdate
End Sub
 
Last edited:
Status
Not open for further replies.
Back
Top