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

Access 2010:

I went through the 'option explicit insruction, now the search as you type filter has a box that appears,

Microsoft Access

Close the form, then open it!

Answer 2

I also have recieved in the code:

Public Function FindAsUTypeChange2 (frm As Form) As Boolean

(yellowed) frm.RecordSource = tmpFilter

Answer 3

Instruction to compiling to Microsoft Access 2010.

Answer 4

You have to type it in, in every module, typically below the "Option Compare Database" statement.

Answer 5

I was inputting the VB code, per the Option Explicit Statement:

' Force explicit variable declaration.

Option Explicit On

Dim thisVar As Integer

thisVar = 10

' The following assignment produces a COMPILIER ERROR because

' the variable is not declared and Option Explicit is On.

thisInt = 10 '  causes ERROR

When I put the code:  Option Explicit On (it errors in red) and I recieve a Compile error: Expected: end of statement