Share via

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

Anonymous
2014-12-05T15:24:25+00:00

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

Microsoft 365 and Office | Access | For home | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

12 answers

Sort by: Most helpful
Most helpful Newest Oldest
  1. Tom van Stiphout 40,091 Reputation points MVP Volunteer Moderator
    2014-12-09T14:12:23+00:00

    Just:

    Option Explicit

    thisInt is not declared, and thus will generate a compile error. You need to first:

    Dim thisInt as Integer

    Why is this important? Consider this code:

    thisInt = 10

    MsgBox thissInt

    What would it show? Not the expected 10.

    In other words: typos go undetected, and nothing good can come of that.

    0 comments
  2. Anonymous
    2014-12-09T15:53:33+00:00

    An alternative filter feature was to be used instead as the search as you type feature errors.

    0 comments