Access 2010 - Database error: Microsoft Visual Basic for Application,,,, Compile error: Sub or Function not defined

Question

Access 2010 - Database Error:  Microsoft Visual Basic Run-time error '3049'

Microsoft: 

Search as you type filter error

Microsoft Visual Basic run-time error '3049' - cannot open database".  It may not be a database that your application recognizes, or the file may be

Debug button:

Public Function FindAsUTypeChange2(frm As Form) As Boolean

'On Error GoTo Err_Handler

    'Purpose:   Filter the form, by the control named in cboFindAsUTypeField and the value in txtFindAsUTypeValue.

    'Return:    True unless an error occurred.

    'Usage:     The code assigns this to the Change event of the text box, and the AfterUpdate event of the combo.

    Dim strText As String       'The text of the text box.

    Dim lngSelStart As Long     'Selection Starting point.

    Dim strField As String      'Name of the field to filter on.

    Dim bHasFocus As Boolean    'True if the text box has focus (since it can be called from the combo too.)

    Dim jj As Integer

    Dim tmpFilter, tmpRecordSourceName As String

    Const strcTextBox = "txtFindAsUTypeValue"

    'If the text box has focus, remember the selection insert point and use its Text. Otherwise use its Value.

    bHasFocus = (frm.ActiveControl.Name = strcTextBox)

    If bHasFocus Then

        strText = frm!txtFindAsUTypeValue.Text

        lngSelStart = frm!txtFindAsUTypeValue.SelStart

    Else

        strText = Nz(frm!txtFindAsUTypeValue.Value, vbNullString)

    End If

    'Save any uncommitted edits in the form. (This loses the insertion point, and converts Text to Value.)

    If frm.Dirty Then

        frm.Dirty = False

    End If

    'Read the filter field name from the combo.

    strField = Nz(frm.cboFindAsUTypeField.Column(micFilterField), vbNullString)

    'Unfilter if there is no text to find, or no control to filter. Otherwise, filter.

    If (strText = vbNullString) Then '  Or (strField = vbNullString) Then

        frm.FilterOn = False

    Else

'        frm.Filter = strField & " Like """ & IIf(mbcStartOfField, vbNullString, mstrcWildcardChar) & _

'            strText & mstrcWildcardChar & """"

' RAGS

' (Exacttext like "*ncp*") or ( notes like "*rich*")

' rags 5/31/12 - the filter holds the exact control instead of the lookup_

' ([Lookup_ScopeOfSupplyIDCombo].[NickName]="FABCON") is good

' ScopeofSupplyID = "F" is bad

' can't filter on combo boxes because I change the recordsource, not the filter.  ****.

        iRS = 0

        tmpFilter = ""

        For iRS = 0 To maxRS - 1

            tmpFilter = tmpFilter & "( " & astrRS(iRS) & " Like """ & IIf(mbcStartOfField, vbNullString, mstrcWildcardChar) & _

                strText & mstrcWildcardChar & """" & ") or "

        Next iRS

        If IsNull(tmpFilter) Or ("" = tmpFilter) Then

            MsgBox "Close the form, then open it!"

        Else ' added apr 11

            tmpFilter = Left(tmpFilter, Len(tmpFilter) - 4)

            tmpRecordSourceName = "[" & frm.NavigationCaption & "]"

            'tmpFilter = "SELECT " & tmpRecordSourceName & ".*, * FROM " & tmpRecordSourceName & " Where " & tmpFilter & " ;"

            tmpFilter = "SELECT * FROM " & tmpRecordSourceName & " Where " & tmpFilter & " ;"

            frm.RecordSource = tmpFilter

            'frm.Requery

        End If

    End If

    'If the control had focus, restore focus if necessary, and set the insertion point.

    If bHasFocus Then

        If frm.ActiveControl.Name <> strcTextBox Then

            frm(strcTextBox).SetFocus

        End If

        If strText <> vbNullString Then

            frm!txtFindAsUTypeValue = strText

            frm!txtFindAsUTypeValue.SelStart = lngSelStart

        End If

    End If

    'Return True if the routine completed without error.

    FindAsUTypeChange2 = True

Exit_Handler:

    Exit Function

Err_Handler:

    Select Case Err.Number

    Case 2474

        Resume Next

    Case 2185   'Text box loses focus when no characters left.

        Resume Exit_Handler

    Case Else

        MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "txtFindAsUTypeValue_Change"

        Resume Exit_Handler

    End Select

End Function

(the from.RecordSource = tmpFilter  :  is yellowed)

Assistance to the instruction to fixing the error.

I used the repair feature of Microsoft, restarting the computer and the Microsoft program.  I then used the repair feature for the database that has the error for a search as you type filter.  The error box now reads:

Microsoft Visual Basic for Application

Compile Error:

Sub or Function not defined

Public Function FindAsUTypeChange2(frm As Form) As Boolean     

'On Error GoTo Err_Handler

    'Purpose:   Filter the form, by the control named in cboFindAsUTypeField and the value in txtFindAsUTypeValue.

    'Return:    True unless an error occurred.

    'Usage:     The code assigns this to the Change event of the text box, and the AfterUpdate event of the combo.

    Dim strText As String       'The text of the text box.

    Dim lngSelStart As Long     'Selection Starting point.

    Dim strField As String      'Name of the field to filter on.

    Dim bHasFocus As Boolean    'True if the text box has focus (since it can be called from the combo too.)

    Dim jj As Integer

    Dim tmpFilter, tmpRecordSourceName As String

    Const strcTextBox = "txtFindAsUTypeValue"

    'If the text box has focus, remember the selection insert point and use its Text. Otherwise use its Value.

    bHasFocus = (frm.ActiveControl.Name = strcTextBox)

    If bHasFocus Then

        strText = frm!txtFindAsUTypeValue.Text

        lngSelStart = frm!txtFindAsUTypeValue.SelStart

    Else

        strText = Nz(frm!txtFindAsUTypeValue.Value, vbNullString)

    End If

    'Save any uncommitted edits in the form. (This loses the insertion point, and converts Text to Value.)

    If frm.Dirty Then

        frm.Dirty = False

    End If

    'Read the filter field name from the combo.

    strField = Nz(frm.cboFindAsUTypeField.Column(micFilterField), vbNullString)

    'Unfilter if there is no text to find, or no control to filter. Otherwise, filter.

    If (strText = vbNullString) Then '  Or (strField = vbNullString) Then

        frm.FilterOn = False

    Else

'        frm.Filter = strField & " Like """ & IIf(mbcStartOfField, vbNullString, mstrcWildcardChar) & _

'            strText & mstrcWildcardChar & """"

' RAGS

' (Exacttext like "*ncp*") or ( notes like "*rich*")

' rags 5/31/12 - the filter holds the exact control instead of the lookup_

' ([Lookup_ScopeOfSupplyIDCombo].[NickName]="FABCON") is good

' ScopeofSupplyID = "F" is bad

' can't filter on combo boxes because I change the recordsource, not the filter.  ****.

        iRS = 0

        tmpFilter = ""

        For iRS = 0 To maxRS - 1

            tmpFilter = tmpFilter & "( " & astrRS(iRS) & " Like """ & IIf(mbcStartOfField, vbNullString, mstrcWildcardChar) & _

                strText & mstrcWildcardChar & """" & ") or "

        Next iRS

        If IsNull(tmpFilter) Or ("" = tmpFilter) Then

            MsgBox "Close the form, then open it!"

        Else ' added apr 11

            tmpFilter = Left(tmpFilter, Len(tmpFilter) - 4)

            tmpRecordSourceName = "[" & frm.NavigationCaption & "]"

            'tmpFilter = "SELECT " & tmpRecordSourceName & ".*, * FROM " & tmpRecordSourceName & " Where " & tmpFilter & " ;"

            tmpFilter = "SELECT * FROM " & tmpRecordSourceName & " Where " & tmpFilter & " ;"

ht frm.RecordSource = tmpFilter

            'frm.Requery

        End If

    End If

    'If the control had focus, restore focus if necessary, and set the insertion point.

    If bHasFocus Then

        If frm.ActiveControl.Name <> strcTextBox Then

            frm(strcTextBox).SetFocus

        End If

        If strText <> vbNullString Then

            frm!txtFindAsUTypeValue = strText

            frm!txtFindAsUTypeValue.SelStart = lngSelStart

        End If

    End If

    'Return True if the routine completed without error.

    FindAsUTypeChange2 = True

Exit_Handler:

    Exit Function

Err_Handler:

    Select Case Err.Number

    Case 2474

        Resume Next

    Case 2185   'Text box loses focus when no characters left.

        Resume Exit_Handler

    Case Else

        MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "txtFindAsUTypeValue_Change"

        Resume Exit_Handler

    End Select

End Function

The code is Yellowed - Public Function FindAsUTypeChange2(frm As Form) As Boolean

Answer 1

What does tmpFilter evaluate to at the time the that line of code is run?

Answer 2

the microfsoft visual basic for applications reads:

(yellowed) public function FindAsUTypeChange2 (frm As Form) As Boolean

Answer 3

My guess is you do not have:

Option Explicit

at the top of EVERY code module.

Please put that in now.

Then go to Code window > Tools > Options and check the box "Require Variable Declaration".

Then choose Debug > Compile and fix the problems until you get a clean compile.

Main Access Window > File > Info > Compact & Repair.

Now try again.

If still a problem, search the web for "Access decompile" and follow the instructions.

Answer 4

Could you share to where the the 'option explicit statement' is located within access 2010.

Answer 5

Second line of the module, right below the Option Compare.