Results 1 to 12 of 12
  1. #1
    Euler is offline Advanced Beginner
    Windows 7 32bit Access 2010 32bit
    Join Date
    Feb 2015
    Posts
    35

    Calback function problem

    Hello,



    I'm trying to use the callback function described in the following MS document to add "(All)" to a list box:

    https://docs.microsoft.com/en-us/off...ox-or-list-box

    It isn't working for me and I don't know why. My row source has two columns but I've tried using just one column and I get the same error message:

    Object variable or With block variable not set

    Can someone help me out with this? Thanks.

  2. #2
    kd2017 is online now Well, I tried at least.
    Windows 10 Access 2016
    Join Date
    Jul 2017
    Posts
    909
    Please post your code. It might also be helpful to put a breakpoint at the top of the sub and step through the execution of the sub line by line (press F8 to execute the next line) and let us know where it fails.

  3. #3
    Euler is offline Advanced Beginner
    Windows 7 32bit Access 2010 32bit
    Join Date
    Feb 2015
    Posts
    35
    Code:
    Function AddAllToList(ctl As Control, lngID As Long, lngRow As Long, _ 
    lngCol As Long, intCode As Integer) As Variant 
     
    Static dbs As Database, rst As Recordset 
    Static lngDisplayID As Long 
    Static intDisplayCol As Integer 
    Static strDisplayText As String 
    Dim intSemiColon As Integer 
     
    On Error GoTo Err_AddAllToList 
    Select Case intCode 
    Case acLBInitialize 
    ' See if function is already in use. 
    If lngDisplayID <> 0 Then 
    MsgBox "AddAllToList is already in use by another control!" 
    AddAllToList = False 
     
    Exit Function 
    End If 
     
    ' Parse the display column and display text from Tag property. 
    intDisplayCol = 1 
    strDisplayText = "(All)" 
    If ctl.Tag <> "" Then 
    intSemiColon = InStr(ctl.Tag, ";") 
    If intSemiColon = 0 Then 
    intDisplayCol = Val(ctl.Tag) 
    Else 
    intDisplayCol = Val(Left(ctl.Tag, intSemiColon - 1)) 
    strDisplayText = Mid(ctl.Tag, intSemiColon + 1) 
     
    End If 
    End If 
     
    ' Open the recordset defined in the RowSource property. 
    Set dbs = CurrentDb 
    Set rst = dbs.OpenRecordset(ctl.RowSource, dbOpenSnapshot) 
     
    ' Record and return the lngID for this function. 
    lngDisplayID = Timer 
    AddAllToList = lngDisplayID 
     
    Case acLBOpen 
    AddAllToList = lngDisplayID 
     
    Case acLBGetRowCount 
    ' Return number of rows in recordset. 
    On Error Resume Next 
     
    rst.MoveLast 
    AddAllToList = rst.RecordCount + 1 
     
    Case acLBGetColumnCount 
    ' Return number of fields (columns) in recordset. 
    AddAllToList = rst.Fields.Count 
     
    Case acLBGetColumnWidth 
    AddAllToList = -1 
     
    Case acLBGetValue 
    If lngRow = 0 Then 
    If lngCol = intDisplayCol - 1 Then 
    AddAllToList = strDisplayText 
    Else 
    AddAllToList = Null 
    End If 
    Else 
     
    rst.MoveFirst 
    rst.Move lngRow - 1 
    AddAllToList = rst(lngCol) 
    End If 
    Case acLBEnd 
    lngDisplayID = 0 
    rst.Close 
    End Select 
     
    Bye_AddAllToList: 
    Exit Function 
     
    Err_AddAllToList: 
    MsgBox Err.Description, vbOKOnly + vbCritical, "AddAllToList" 
    AddAllToList = False 
    Resume Bye_AddAllToList 
    End Function
    It seems to be failing at the line rst.MoveFirst for some reason.

  4. #4
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    1,323
    Does noone indent anymore?
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?search_query=debug+access+vba



  5. #5
    Euler is offline Advanced Beginner
    Windows 7 32bit Access 2010 32bit
    Join Date
    Feb 2015
    Posts
    35
    Since I copied the code from

    https://docs.microsoft.com/en-us/off...ox-or-list-box

    you can blame Microsoft.

  6. #6
    kd2017 is online now Well, I tried at least.
    Windows 10 Access 2016
    Join Date
    Jul 2017
    Posts
    909
    I've posted your code below with some indentation.

    Let's do some troubleshooting with the debugger. From what you're telling us it sounds like there is a probelm with this line:
    Code:
    Set rst = dbs.OpenRecordset(ctl.RowSource, dbOpenSnapshot)
    ctl.RowSource should be a string value that either contains an sql statement or the name of a table/query. So there is a problem with what ever you're feeding the parameter which should presumably just be the name of a list box??

    I suggest you put a breakpoint in the line just past that line, on this line:
    Code:
    lngDisplayID = Timer
    Then run your code, it will pause after it runs the Set rst =... line. Hover your mouse over where it says ctl.RowSource to see exactly what that value is for that variable. (you could also use the watch window or print it's value to the immediate window...)

    Code:
    Function AddAllToList(ctl As Control, lngID As Long, lngRow As Long, _
        lngCol As Long, intCode As Integer) As Variant
         
        Static dbs As Database, rst As Recordset
        Static lngDisplayID As Long
        Static intDisplayCol As Integer
        Static strDisplayText As String
        Dim intSemiColon As Integer
         
        On Error GoTo Err_AddAllToList
        
        Select Case intCode
        Case acLBInitialize
            ' See if function is already in use.
            If lngDisplayID <> 0 Then
                MsgBox "AddAllToList is already in use by another control!"
                AddAllToList = False
                 
                Exit Function
            End If
             
            ' Parse the display column and display text from Tag property.
            intDisplayCol = 1
            strDisplayText = "(All)"
            If ctl.Tag <> "" Then
                intSemiColon = InStr(ctl.Tag, ";")
                If intSemiColon = 0 Then
                    intDisplayCol = Val(ctl.Tag)
                Else
                    intDisplayCol = Val(Left(ctl.Tag, intSemiColon - 1))
                    strDisplayText = Mid(ctl.Tag, intSemiColon + 1)
                 
                End If
            End If
             
            ' Open the recordset defined in the RowSource property.
            Set dbs = CurrentDb
            Set rst = dbs.OpenRecordset(ctl.RowSource, dbOpenSnapshot)
             
            ' Record and return the lngID for this function.
            lngDisplayID = Timer
            AddAllToList = lngDisplayID
             
        Case acLBOpen
            AddAllToList = lngDisplayID
         
        Case acLBGetRowCount
            ' Return number of rows in recordset.
            On Error Resume Next
         
            rst.MoveLast
            AddAllToList = rst.RecordCount + 1
         
        Case acLBGetColumnCount
            ' Return number of fields (columns) in recordset.
            AddAllToList = rst.Fields.Count
         
        Case acLBGetColumnWidth
            AddAllToList = -1
         
        Case acLBGetValue
            If lngRow = 0 Then
                If lngCol = intDisplayCol - 1 Then
                AddAllToList = strDisplayText
                Else
                AddAllToList = Null
                End If
            Else
                 
                rst.MoveFirst
                rst.Move lngRow - 1
                AddAllToList = rst(lngCol)
            End If
        Case acLBEnd
            lngDisplayID = 0
            rst.Close
        End Select
     
    Bye_AddAllToList:
        Exit Function
     
    Err_AddAllToList:
        MsgBox Err.Description, vbOKOnly + vbCritical, "AddAllToList"
        AddAllToList = False
        Resume Bye_AddAllToList
        
    End Function

  7. #7
    kd2017 is online now Well, I tried at least.
    Windows 10 Access 2016
    Join Date
    Jul 2017
    Posts
    909
    DISREGARD POST #6

    1) Simply copy and past the code from m$ as is and add it to a module
    2) In your list or combobox properties go to the Data tab and set the value for Row Source Type to AddAllToList. You'll have to type it in as it won't be included in the combobox dropdown.

    To utilize the AddAllToList procedure, you must set the RowSourceType property of the combo box or list box to AddAllToList.
    *Note: An issue I see with this from a usability standpoint is that the (All) is added to the first column, for me personally that's usually a primary key column and it's hidden so only a blank row would be visible to the user... You can change the intDisplayCol variable in the AddAllToList code to suite your need

  8. #8
    Euler is offline Advanced Beginner
    Windows 7 32bit Access 2010 32bit
    Join Date
    Feb 2015
    Posts
    35
    OK, I took out "ctl.RowSource" from the "Set rst..." line and substituted a string variable called "str". Above the "Set rst..." line I then defined "str" as what was in the RowSource property of the list box. I then deleted what was in the RowSource property.

    The result was the same error message.

  9. #9
    Euler is offline Advanced Beginner
    Windows 7 32bit Access 2010 32bit
    Join Date
    Feb 2015
    Posts
    35
    I did those things.

  10. #10
    kd2017 is online now Well, I tried at least.
    Windows 10 Access 2016
    Join Date
    Jul 2017
    Posts
    909
    I rearranged some things. Try this code instead:

    Code:
    Function AddAllToList(ctl As Control, lngID As Long, lngRow As Long, _
    lngCol As Long, intCode As Integer) As Variant
     
    Static dbs As Database, rst As Recordset
    Static lngDisplayID As Long
    Static intDisplayCol As Integer
    Static strDisplayText As String
    Dim intSemiColon As Integer
     
    On Error GoTo Err_AddAllToList
    
        ' Open the recordset defined in the RowSource property.
        Set dbs = CurrentDb
        Set rst = dbs.OpenRecordset(ctl.RowSource, dbOpenSnapshot)
            
        Select Case intCode
            Case acLBInitialize
            ' See if function is already in use.
            If lngDisplayID <> 0 Then
                MsgBox "AddAllToList is already in use by another control!"
                AddAllToList = False
                 
                Exit Function
            End If
             
            ' Parse the display column and display text from Tag property.
            intDisplayCol = 1
            strDisplayText = "(All)"
            If ctl.Tag <> "" Then
                intSemiColon = InStr(ctl.Tag, ";")
                If intSemiColon = 0 Then
                    intDisplayCol = Val(ctl.Tag)
                Else
                    intDisplayCol = Val(Left(ctl.Tag, intSemiColon - 1))
                    strDisplayText = Mid(ctl.Tag, intSemiColon + 1)
                 
                End If
            End If
             
            ' Open the recordset defined in the RowSource property.
            'Set dbs = CurrentDb
            'Set rst = dbs.OpenRecordset(ctl.RowSource, dbOpenSnapshot)
             
            ' Record and return the lngID for this function.
            lngDisplayID = Timer
            AddAllToList = lngDisplayID
         
        Case acLBOpen
            AddAllToList = lngDisplayID
         
        Case acLBGetRowCount
            ' Return number of rows in recordset.
            On Error Resume Next
             
            rst.MoveLast
            AddAllToList = rst.RecordCount + 1
             
        Case acLBGetColumnCount
            ' Return number of fields (columns) in recordset.
            AddAllToList = rst.Fields.Count
             
        Case acLBGetColumnWidth
            AddAllToList = -1
         
        Case acLBGetValue
            If lngRow = 0 Then
                If lngCol = intDisplayCol - 1 Then
                    AddAllToList = strDisplayText
                Else
                    AddAllToList = Null
                End If
            Else
                 
                rst.MoveFirst
                rst.Move lngRow - 1
                AddAllToList = rst(lngCol)
            End If
        Case acLBEnd
            lngDisplayID = 0
            rst.Close
        End Select
        
        'rst.Close
     
    Bye_AddAllToList:
        'Set dbs = Nothing
        'Set rst = Nothing
        Exit Function
     
    Err_AddAllToList:
        MsgBox Err.Description, vbOKOnly + vbCritical, "AddAllToList"
        AddAllToList = False
        Resume Bye_AddAllToList
    End Function
    Last edited by kd2017; 09-28-2021 at 11:11 AM. Reason: commented out closing and setting objects to nothing... caused problems

  11. #11
    Euler is offline Advanced Beginner
    Windows 7 32bit Access 2010 32bit
    Join Date
    Feb 2015
    Posts
    35
    Thanks to everyone for their help but I found the problem.

    I had some code in the Load event that hides the Switchboard. When I remmed out that line in the Load event the callback function ran perfectly. Somehow, that line interfered with the callback function's work. Maybe the static variables are disrupted, for lack of a better word.

    I put the line to hide the Switchboard in the acLBEnd section of the callback function and so far so good.

    Thanks again to everyone for putting time into this.

  12. #12
    kd2017 is online now Well, I tried at least.
    Windows 10 Access 2016
    Join Date
    Jul 2017
    Posts
    909
    I'm glad you figured it out!

Please reply to this thread with any new information or opinions.

Similar Threads

  1. The problem with the function sum()
    By end in forum Access
    Replies: 2
    Last Post: 01-31-2016, 03:41 PM
  2. Problem with IIF function
    By donnysl in forum Queries
    Replies: 3
    Last Post: 08-12-2013, 10:11 AM
  3. Problem with function?
    By devxweb in forum Access
    Replies: 2
    Last Post: 01-07-2013, 08:43 AM
  4. Problem with IIF function
    By Hulk in forum Forms
    Replies: 3
    Last Post: 03-20-2011, 12:59 PM
  5. VBA Function problem
    By smikkelsen in forum Programming
    Replies: 5
    Last Post: 07-16-2010, 07:46 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums