Access VBA Crashes, No Error Codes

[sirhannick]

I am having a serious issue with some of my VBA code in my Access front end. It links to a SQL database. Here is my code:

Private Sub New_Record_Click()
    Dim MySerial As String
    Dim rsCriteria As String
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim Feedback

    Set db = CurrentDb
    Set rs = db.OpenRecordset("FourWire", dbOpenDynaset)

    On Error GoTo ErrorHandlingCode

    MySerial = InputBox("Serial #", "New Part")
    rsCriteria = "[Serial] = '" & MySerial & "'"
    If MySerial = "" Then
        Exit Sub
    End If

    rs.FindFirst rsCriteria                            'Search for existing record
    If rs.NoMatch Then
        'Good, so lets make a new record!
    Else
        Feedback = MsgBox("Record for this part already exists!" & vbCr & "Would you like go to the record?", vbYesNo, "Warning")
        GoTo LoadExistingRecord
    End If

    'Me.FilterOn = False                                        'turn off filter
    DoCmd.GoToRecord , , acNewRec
    [Serial_FourWire].value = MySerial
    DoCmd.Requery
    rsCriteria = "[Serial] = '" & MySerial & "'"
    'Me.[Black_Blue].SetFocus

    rs.Close

    DoCmd.Echo False
    Forms("Four_Wire_Test").Recordset.FindFirst rsCriteria
    If Forms("Four_Wire_Test").Recordset.NoMatch Then
        MsgBox "Could not find record just created! Contact your administrator."
    End If
    DoCmd.Echo True

    Exit Sub

LoadExistingRecord:
    If Feedback = vbYes Then
        Forms("Four_Wire_Test").Recordset.FindFirst rsCriteria    'User clicked "Yes"
        Me.[Black_Blue].SetFocus
    Else
        'Just Quit                                               'User clicked "No"
    End If

    Exit Sub

ErrorHandlingCode:
   Dim strError As String
   Dim errLoop As Error

   For Each errLoop In Errors
        With errLoop
        strError = _
           "Error #" & .Number & vbCr
        strError = strError & _
           "  " & .Description & vbCr
        strError = strError & _
           "  (Source: " & .Source & ")" & vbCr
        strError = strError & _
           "Press F1 to see topic " & .HelpContext & vbCr
        strError = strError & _
           "  in the file " & .HelpFile & "."
     End With
     MsgBox strError
   Next
End Sub

I have managed to isolate the crash, which entirely takes down Access 2007, without a fault. The line is:

    Forms("Four_Wire_Test").Recordset.FindFirst rsCriteria

One note is that I have used this code successfully before in other places of my front end. "rsCritera" is equal to "[Serial] = '1234567'". I have confirmed that "1234567" exists in the table "FourWire".

Does anyone have any recommendations as to what I am doing? Why access is just crashing and not able to give me a fault code or anything? Any help is much appreciated.
:banghead:

 

[Privateer]

First of all, you're trying to do too much in one procedure. Second, anytime you have the backend on SQL you need to include dbSeeChanges when you open the recordset. Hope all this stuff helps.

In one procedure check for an exiting record, you might need to use this often before you add a new record, so keep it separate.

Procedure Sub CheckDupe
Dim dbs As DAO.Database
Dim rstDupe As DAO.Recordset

Set dbs = CurrentDb

Criteria = "([tblFourWire].[Serial]=""" & MySerial & """)"

strSQL = "SELECT [tblFourWire].[SerialID], [tblFourWire].[PartName], [tblFourWire].[Serial] FROM [tblFourWire] WHERE (" & Criteria & ");"

Set rstDupe = dbs.OpenRecordset(strSQL, dbOpenSnapshot, dbFailOnError)

With rstDupe
If .BOF = True And .EOF = True Then
'no duplicate record
Else
strMsg = "The " & Trim(!PartName) with serial number " & Trim(!Serial) & "is already in the database."
MsgBox strMsg, vbCritical + vbOKOnly, "Duplicate"
End If
.Close
End With

Try something like this, I use it in all my databases to add a new record, its transactional, so unless it works it won't hit the table, meaning you won't get an empty row or a skipped primary key.

Private Sub AddData()
On Error GoTo ErrorHandler
'Adds the new to the database

Dim wksp As Workspace
Dim rstNew As DAO.Recordset

Set wksp = DBEngine.Workspaces(0)
Set dbs = CurrentDb

Set rstNew = dbs.OpenRecordset("tblFourWire", dbOpenDynaset, dbSeeChanges + dbAppendOnly)

wksp.BeginTrans 'Needs to be before any possible errors so rollback doesn't cause another

On Error GoTo DirtyExit

With rstNew
.AddNew
![Serial] = MySerial 'The new serial number
![PartName] = MyPartName 'The new part name
.Update
End With
wksp.CommitTrans (dbForceOSFlush)

On Error GoTo CleanExit
wksp.Close

CleanExit:
Set wksp = Nothing
Set rstNew = Nothing
Set dbs = Nothing
Exit Sub

DirtyExit:
wksp.Rollback
GoTo CleanExit

ErrorHandler:
Resume CleanExit
End Sub

 

[JHB]

First comment out the error handling until the code runs correct.
Is form "Four_Wire_Test" the current form in which the code runs?
Does the recordsource for the form "Four_Wire_Test" contain the [Serial] field?
Are you sure the [Serial] field is a text fieldtype in the table?

Personally I don't like "Goto" and labels in codes, (except for errorhandling), it gives a messy code.

And Privateer, please use code tags, when you post code!

 

[BlueIshDan]

Does it hang up for a bit before it crashes?
Or does it immediately drop out?
Also when it crashes, does it stay in your processes listing in your Task Manager?

 

[sirhannick]

First comment out the error handling until the code runs correct.
Is form "Four_Wire_Test" the current form in which the code runs?

Yes, "Four_Wire_Test" is the name of the form

Does the recordsource for the form "Four_Wire_Test" contain the [Serial] field?

Good question! My SQL is not that strong, but here is the record source for the form:

SELECT FourWire.Serial, FourWire.BlkBlu, FourWire.OrgBlu, FourWire.BlkOrg, FourWire.EEPROMRh, FourWire.AmbientTemp, FourWire.Factor, EOL_Data.RH_Target
FROM ([NOx Inventory] INNER JOIN EOL_Data ON [NOx Inventory].Datamatrix = EOL_Data.Datamatrix) INNER JOIN FourWire ON [NOx Inventory].[Serial #] = FourWire.Serial;

Are you sure the [Serial] field is a text fieldtype in the table?

Yes, a typical [Serial] = '140_P2872944_________'

Sorry for the late reply, I was traveling...

 

[sirhannick]

Does it hang up for a bit before it crashes?
Or does it immediately drop out?
Also when it crashes, does it stay in your processes listing in your Task Manager?

I believe it initially says it is waiting for the program to respond and then realizes it has crashed and attempts to recover. There isn't much of a delay, but the VBA code running before it.

 

[BlueIshDan]

on the bottom right corner does it show a green loading bar or display a message saying that it is running something?

 

[JHB]

Did you comment out the error handling and did database still crash without an error?

 

[BlueIshDan]

Dim errLoop as Variant.
Might work, sometimes it gets pissy at me for using the respective object type in a foreach statement

 

[spikepl]

You have shown an active error handler and, further, you have a DoCmd.Echo False

This is equivalent of closing your eyes before fumbling through a mine field. A bit silly while debugging, don't you think?

 

[BlueIshDan]

You have shown an active error handler and, further, you have a DoCmd.Echo False

This is equivalent of closing your eyes before fumbling through a mine field. A bit silly while debugging, don't you think?

Lol! I love the imagery!

 

[sirhannick]

You have shown an active error handler and, further, you have a DoCmd.Echo False

This is equivalent of closing your eyes before fumbling through a mine field. A bit silly while debugging, don't you think?

I was not aware of that. I guess that's the danger with taking code from the internet and not 100% understanding it.

I think I have resolved the issue(s). The recordsource for Four_Wire_Test had a requirement that the part serial number entered also be in the "NOx Inventory" table. However, this did not always turn out to be true. So if a serial number that didn't already exist in NOx Inventory was entered, it would not appear in the "query" (not sure if this is a correct use of the term). Perhaps this upset the program.

Also, I found that unlike all of my other tables where I defined [Serial] as nvarchar[255], I for some stupid reason defined it as nchar[255]. This resulted in all of the records being padded with spaces out to 255 characters. This could've been another reason.

Here is my current code:

Private Sub New_Record_Click()
    Dim MySerial As String
    Dim rsCriteria As String
    Dim Feedback
    Dim db As DAO.Database
    Dim rs As DAO.Recordset

    Set db = CurrentDb
    Set rs = db.OpenRecordset("NOx Inventory", dbOpenDynaset)

    On Error GoTo ErrorHandlingCode

    MySerial = InputBox("Serial #", "New Part")
    
    If MySerial = "" Then
        Exit Sub
    End If

    rsCriteria = "[Serial #] = '" & MySerial & "'"
    rs.FindFirst rsCriteria                            'Search for existing record
    If rs.NoMatch Then
        MsgBox ("This sensor does not exist in the NOx Inventory. Please enter in the NOx Inventory before proceeding with the 4-Wire Test.")
        Exit Sub
    Else    'Good, it exists in the NOx Inventory now search the FourWire table
        MsgBox "Match found in NOx Inventory"
        rs.Close
        Set rs = db.OpenRecordset("FourWire", dbOpenDynaset)
        rsCriteria = "[Serial] = '" & MySerial & "'"
        rs.FindFirst rsCriteria
        If rs.NoMatch Then
            'does not exist, we can create a new record
            'MsgBox "No Match in Four Wire"
        Else
            Feedback = MsgBox("Record for this part already exists!" & vbCr & "Would you like go to the record?", vbYesNo, "Warning")
            GoTo LoadExistingRecord
        End If
        
    End If
    
    'Me.FilterOn = False                                        'turn off filter
    DoCmd.GoToRecord , , acNewRec
    [Serial_FourWire].value = MySerial
    DoCmd.Requery
    'Me.[Black_Blue].SetFocus
    rs.Close
    
    rsCriteria = "[Serial] = '" & MySerial & "'"

    'DoCmd.Echo False
    Forms("Four_Wire_Test").Recordset.FindFirst rsCriteria
    If Forms("Four_Wire_Test").Recordset.NoMatch Then
        MsgBox "Could not find record just created! Contact your administrator."
    End If
    'DoCmd.Echo True

Exit Sub
    
LoadExistingRecord:
    If Feedback = vbYes Then
        Forms("Four_Wire_Test").Recordset.FindFirst rsCriteria    'User clicked "Yes"
        Me.[Black_Blue].SetFocus
    Else
        'Just Quit                                               'User clicked "No"
    End If

Exit Sub

ErrorHandlingCode:
   Dim strError As String
   Dim errLoop As Error

   For Each errLoop In Errors
        With errLoop
        strError = _
           "Error #" & .Number & vbCr
        strError = strError & _
           "  " & .Description & vbCr
        strError = strError & _
           "  (Source: " & .Source & ")" & vbCr
        strError = strError & _
           "Press F1 to see topic " & .HelpContext & vbCr
        strError = strError & _
           "  in the file " & .HelpFile & "."
     End With
     MsgBox strError
   Next
End Sub

Perhaps you all have some ideas of which sin that I committed was the most sinful of all? :banghead:

Thank you all for your help!