Access Database Run-time error '2471

Hello,

We are having issue(s) with a access database and I have attached 2 files of which one is a screen shot of the error and one a text file with the debug code information. Also I've copied below.

This popup error just started Monday, March 19, 2012 (morning) as all was working the day before. I've talk to the users accessing and using this DB, but can't get anything unusual that they've seen happen while working, other than this error.

History of this DB: Was built before I came to this company in 97 MS Access, and has been upgrade in 2003 to Access 2003.  From that time we have used both 2003 access and once 2007 Access came out I had 2 users using 2007 with one user using 2003 Access. There has been no other code changes are additions from the build date, only the upgrade from 97 Access to 2003 Access.

I have separate backups over time and I have grab some older backups where I'm 100% sure we had no issues adding new job numbers and the same error popup is generated using Access 2007 and Access 2003. I'm almost thinking it's a software version issue, but I could use thoughts from you guys. This is an important DB for this small business and need to get this error issue corrected asap.

Thank You

JOb# 12-2442  <<<< When any new Job Number is typed in this box we get the below error, and if we just select "END" on the error, then keep entering the below information, the program never goes to the next step, nor does the Job list in the tables, it just does nothing.)

Cust ID S0033

SHIP EXT 5

MODEL BB2PWD

MODEL # 428

SERIAL # 12-1514

ELEC CODE  NON CLASS

ENGINEER  JMH (MIKE)



Popup Error
************************************************************************
Run-time error '2471'The expression you entered as a query parameter produced this

error: 'vJOBNUMB'
************************************************************************



************************************************************************
ced1 - Form_Add Job (Code)
************************************************************************

Option Compare Database
Option Explicit
Public vJOBNUMB As String, vNAME As String, vNUMB As String _
        , vNAMENUMB As String, vECODE As String, vENG As String _
        , vCustID As String, vSerial As String, vSHIPEXT As String, vSECT As String _
        , vBILLNAME As String, mBILLNAME As String, vExists As Variant
Public Sub AddNewJobButton_Click()
    If vJOBNUMB = "" Then
        Exit Sub
    End If
    If vNAME = "" Then
        Exit Sub
    End If
    If vNUMB = "" Then
        Exit Sub
    End If
    If vECODE = "" Then
        Exit Sub
    End If
    If vCustID = "" Then
        Exit Sub
    End If
    If vSHIPEXT = "" Then
        Exit Sub
    End If
   
    If vENG = "" Then
    vENG = " "
    End If
    If vSerial = "" Then
    vSerial = " "
    End If
   
    vNAMENUMB = vNAME & " " & vNUMB
    DoCmd.OpenForm "Machine Form 1"
    DoCmd.RunCommand acCmdRecordsGoToNew
   
    Forms![machine form 1]!MAJOBNO = vJOBNUMB
   
    Forms![machine form 1]!PREJOBNO = _
    IIf(Mid$([vJOBNUMB], 3, 1) = "-", Left$([vJOBNUMB], 2), " ")
   
    Forms![machine form 1]!SUFJOBNO = _
    IIf(Mid$([vJOBNUMB], 3, 1) = "-", Mid$([vJOBNUMB], 4, 5), [vJOBNUMB])
   
    Forms![machine form 1]!MODEL = vNAMENUMB
    Forms![machine form 1]![model form 2]!MODEL = vNAMENUMB
   
    Forms![machine form 1]!ELECODE = vECODE
   
    Forms![machine form 1]!ENGINEER = vENG
   
    Forms![machine form 1]!CUSTID = vCustID
   
    Forms![machine form 1]!SERIAL = vSerial
    Forms![machine form 1]![model form 2]!SERIAL = vSerial
   
    Forms![machine form 1]!SHIPID = vSHIPEXT
    Forms![machine form 1]![model form 2]!SECTION = vSECT
   
    Forms![machine form 1]![model form 2]!MODELPRE = vNAME
   
    Call CreateJobTable(vJOBNUMB)
    DoCmd.GoToControl "SHIPDATE"
   
           
 End Sub

Private Sub CloseForm_Click()
On Error GoTo Err_CloseForm_Click
    DoCmd.Close
Exit_CloseForm_Click:
    Exit Sub
Err_CloseForm_Click:
    msgbox Err.Description
    Resume Exit_CloseForm_Click
End Sub


Private Sub mCUSTID_AfterUpdate()
Dim ctlList As Control
vCustID = mCUSTID
    ' Return Control object pointing to list box.
    Set ctlList = Forms![add job]!mSHIPEXT
    ' Requery source of data for list box.
    ctlList.Requery
'DoCmd.Requery mSHIPEXT
End Sub

Private Sub mCUSTID_Enter()
Dim strMsg As String
vExists = DLookup("[majobno]", "machine", "[majobno]=vJOBNUMB")
'vSECT = DLookup("[cedsection]", "cedmodel", "[cedmodel]=mname")

If IsNull(vExists) Then
    Exit Sub
Else
    strMsg = msgbox("That job already exists, please re-enter.", vbExclamation)
    vJOBNUMB = ""
    NewJobNumb = ""
    NewJobNumb.SetFocus
End If

End Sub

Private Sub mECODE_AfterUpdate()
vECODE = mECODE
End Sub

Private Sub mENG_AfterUpdate()
vENG = mENG
End Sub

Private Sub mNAME_AfterUpdate()
vNAME = mNAME
vSECT = DLookup("[cedsection]", "cedmodel", "[cedmodel]=mname")
mSECT = vSECT
End Sub

Private Sub mNUMB_AfterUpdate()
vNUMB = mNUMB
End Sub

Private Sub mSERIAL_AfterUpdate()
vSerial = mSERIAL
End Sub

Private Sub mSHIPEXT_AfterUpdate()
vSHIPEXT = mSHIPEXT
End Sub

Private Sub NewJobNumb_AfterUpdate()

vJOBNUMB = NewJobNumb

End Sub

Private Sub XBox_Click()
On Error GoTo Err_XBox_Click


    DoCmd.Close

Exit_XBox_Click:
    Exit Sub

Err_XBox_Click:
    msgbox Err.Description
    Resume Exit_XBox_Click
   
End Sub





************************************************************************
CED1 - Form_frmPartsPriceListReprint(Code)
************************************************************************

Option Compare Database
Option Explicit
Dim qdf As QueryDef
Dim frm As Form
Dim ctl As Control
Dim varItm As Variant
Dim intI As Integer
Dim vModel As String, vSubCode As String
Dim vElecode As String
Dim vcedSection As String, vSubsection As String
Dim vSerial As String, vSubName As String, vCustName As String
Public vJobno As String
Public dbs As Database
Public rst As Recordset, rst2 As Recordset, rst3 As Recordset
Public strsql As String, strSQL2 As String, strSQL3 As String, strSQL4 As String
Public vJMSJobNo As String, vJMSModel As String, vJMSSerial As String
Public vJMSSub As String, vJMSCedSection As String, vJMSSubSection As String
Public vShipID As Integer, vCustID As String, vCityID As String, vStID As String
Public vFound As Variant, tbl
Public vModelPre As String, vModelName As String

'######################################
Sub PartsPriceListReprint2()

On Error GoTo err_PartsPriceListReprint
Set frm = Forms!frmPartsPriceListReprint
Set ctl = frm!lstSubs
Set dbs = CurrentDb
'''''''''''''''''''''''''''''''''''''''''''''
Dim intloop As Integer

dbs.TableDefs.Refresh
  For Each tbl In dbs.TableDefs
   If tbl.Name = "reprntable" Then
    dbs.TableDefs.Delete tbl.Name
   End If
  Next tbl
 
'vJobno = "98-1834"
vJobno = Forms!frmPartsPriceListReprint.cboCurrent
'DoCmd.Close acForm, "frmPartsPriceListReprint"
    DoCmd.TransferDatabase acLink, "Microsoft Access", _
        "\\cedserver1\ced\ced11.mdb", acTable, vJobno, "reprntable"

vCustID = DLookup("[custid]", "machine", "majobno = '" & vJobno & "'")
vShipID = DLookup("[shipid]", "machine", "majobno = '" & vJobno & "'")

For Each varItm In ctl.ItemsSelected
vJMSJobNo = ctl.Column(0, varItm)
vJMSModel = ctl.Column(1, varItm)
vJMSSub = ctl.Column(2, varItm)
vJMSSerial = ctl.Column(3, varItm)
vJMSCedSection = ctl.Column(4, varItm)
vJMSSubSection = ctl.Column(5, varItm)
Debug.Print vJMSJobNo
Debug.Print vJMSModel
Debug.Print vJMSSub
Debug.Print vJMSSerial
Debug.Print vJMSCedSection
Debug.Print vJMSSubSection
Debug.Print
vModelPre = DLookup("[cedmodel]", "cedmodel", "cedsection = '" & vJMSCedSection & "'")
vModelName = DLookup("[ceddesc]", "cedmodel", "cedsection = '" & vJMSCedSection & "'")
            'DELETE CURRENT QUERY USED TO CREATE SECTION OF REPORT
  dbs.QueryDefs.Refresh
  For Each qdf In dbs.QueryDefs
   If qdf.Name = "QPartsPriceList" Then
    dbs.QueryDefs.Delete qdf.Name
   End If
  Next qdf
  dbs.QueryDefs.Refresh
  For Each qdf In dbs.QueryDefs
   If qdf.Name = "QPartsPriceList2" Then
    dbs.QueryDefs.Delete qdf.Name
   End If
  Next qdf
  dbs.QueryDefs.Refresh
  For Each qdf In dbs.QueryDefs
   If qdf.Name = "QPartsPriceList3" Then
    dbs.QueryDefs.Delete qdf.Name
   End If
  Next qdf
'            'ADD CODE HERE FOR GETTING PARTS FROM XX-XXXX TABLE
   
  strSQL3 = ""
  strSQL3 = strSQL3 + "SELECT * FROM reprntable"
  strSQL3 = strSQL3 + " WHERE modelpre = '" & vModelPre & "' and"
  strSQL3 = strSQL3 + " subcode = '" & vJMSSub & "' and"
  strSQL3 = strSQL3 + " model = '" & vJMSModel & "' and"
  strSQL3 = strSQL3 + " custprint =  'Y' "
  strSQL3 = strSQL3 + " ORDER BY majobno, modelpre, subcode, partno"
 
  Set qdf = dbs.CreateQueryDef("QPartsPriceList", strSQL3)
  DoCmd.OpenQuery qdf.Name
  DoCmd.Close acQuery, qdf.Name
            'END CODE HERE FOR GETTING PARTS FROM XX-XXX TABLE
            'ADD CODE FOR SECOND QUERY TO GET LOCATION AND SERIAL #
  strSQL4 = ""
  strSQL4 = strSQL4 + "SELECT * FROM model"
  strSQL4 = strSQL4 + " WHERE model = '" & vJMSModel & "' and"
  strSQL4 = strSQL4 + " mojobno = '" & vJMSJobNo & "'"
 
  Set qdf = dbs.CreateQueryDef("QPartsPriceList2", strSQL4)
  DoCmd.OpenQuery qdf.Name
  DoCmd.Close acQuery, qdf.Name
'            'END CODE FOR SECOND QUERY TO GET LOCATION AND SERIAL #

            'ADD CODE HERE FOR GETTING SHIP TO CITY ONLY
  Debug.Print vShipID
  strSQL5 = ""
  strSQL5 = strSQL5 + "SELECT shpcity, shp FROM custship"
  strSQL5 = strSQL5 + " WHERE custid = '" & vCustID & "' and shipext = " & vShipID
  'strSQL5 = strSQL5 + " shipext = vShipID "
  Debug.Print strSQL5
 
  Set qdf = dbs.CreateQueryDef("QPartsPriceList3", strSQL5)
  DoCmd.OpenQuery qdf.Name
  DoCmd.Close acQuery, qdf.Name
   'DoCmd.OpenReport "Parts Price List", acViewPreview 'Report is based on query
   DoCmd.OpenReport "Parts Price List", acViewNormal 'Report is based on query
   DoCmd.Close acReport, "Parts Price List"
            'GO TO NEXT RECORD IN SELECTED ITEMS IN COMBO BOX'
Next varItm

Res_NoRecord:
Exit Sub
Set dbs = Nothing

exit_PartsPriceListReprint:
Exit Sub

err_PartsPriceListReprint:
Select Case Err.Number
Case Else
msgbox "Error number: " & Err.Number & " - " & Err.Description
End Select

Resume Res_NoRecord

End Sub

Private Sub cboCurrent_AfterUpdate()
lstSubs.Requery
End Sub

Private Sub Reprint_Click()
Call PartsPriceListReprint2
Call XBox_Click

End Sub

Private Sub XBox_Click()
On Error GoTo Err_XBox_Click
    DoCmd.Close
Exit_XBox_Click:
    Exit Sub
Err_XBox_Click:
    msgbox Err.Description
    Resume Exit_XBox_Click
End Sub
ADDNEWJOB.txt
PrintScreen-Error-2471.docx