Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions

Type Mismatch with AddAlltoList

Posted on 2009-03-31
Last Modified: 2012-05-06
I get the AddAlltoList function (http://support.microsoft.com/?kbid=210290) to work fine in Access 2007 but in Access 2003 I get a "Type Mismatch" error at the line:

Set RS = DB.OpenRecordset(C.RowSource, DB_OPEN_SNAPSHOT)

I added AddAlltoList as the RowSourceType of a multiselect listbox with Row Source:

SELECT tbl_SysGroups.SysGroupID, tbl_SysGroups.SysGroupName FROM tbl_SysGroups ORDER BY tbl_SysGroups.SysGroupName

and Tag set to 2;(All)

Any idea why? Complete function is below for reference.

Function AddAllToList(C As Control, ID As Long, Row As Long, Col As Long, Code As Integer) As Variant
      ' FUNCTION: AddAllToList()
      ' PURPOSE:
      '   Adds "(all)" as the first row of a combo box or list box.
      ' USAGE:
      '   1. Create a combo box or list box that displays the data you
      '      want.
      '   2. Change the RowSourceType property from "Table/Query" to
      '      "AddAllToList."
      '   3. Set the value of the combo box or list box's Tag property to
      '      the column number in which you want "(all)" to appear.
      '   NOTE: Following the column number in the Tag property, you can
      '   enter a semicolon (;) and then any text you want to appear
      '   other than the default "all."
      '         For example
      '             Tag: 2;<None>
      '         displays "<None>" in the second column of the list.
         Static DB As Database, RS As Recordset
         Static DISPLAYID As Long
         Static DISPLAYCOL As Integer
         Static DISPLAYTEXT As String
         Dim Semicolon As Integer
      'On Error GoTo Err_AddAllToList
         Select Case Code
            Case LB_INITIALIZE
               ' See if the function is already in use.
               If DISPLAYID <> 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 the Tag
               ' property.
               DISPLAYCOL = 1
               DISPLAYTEXT = "(All)"
               If Not IsNull(C.Tag) Then
                  Semicolon = InStr(C.Tag, ";")
                  If Semicolon = 0 Then
                     DISPLAYCOL = Val(C.Tag)
                     DISPLAYCOL = Val(Left(C.Tag, Semicolon - 1))
                     DISPLAYTEXT = Mid(C.Tag, Semicolon + 1)
                  End If
               End If
               ' Open the recordset defined in the RowSource property.
               Set DB = DBEngine.Workspaces(0).Databases(0)
               Set RS = DB.OpenRecordset(C.RowSource, DB_OPEN_SNAPSHOT)
               ' Record and return the ID for this function.
               DISPLAYID = Timer
               AddAllToList = DISPLAYID
            Case LB_OPEN
               AddAllToList = DISPLAYID
            Case LB_GETROWCOUNT
               ' Return the number of rows in the recordset.
               AddAllToList = RS.RecordCount + 1
            Case LB_GETCOLUMNCOUNT
               ' Return the number of fields (columns) in the recordset.
               AddAllToList = RS.Fields.Count
            Case LB_GETCOLUMNWIDTH
               AddAllToList = -1
            Case LB_GETVALUE
               ' Are you requesting the first row?
               If Row = 0 Then
                  ' Should the column display "(All)"?
                  If Col = DISPLAYCOL - 1 Then
                     ' If so, return "(All)."
                     AddAllToList = DISPLAYTEXT
                     ' Otherwise, return NULL.
                     AddAllToList = Null
                  End If
                  ' Grab the record and field for the specified row/column.
                  RS.Move Row - 1
                  AddAllToList = RS(Col)
               End If
            Case LB_END
               DISPLAYID = 0
         End Select
         Exit Function
Beep:          MsgBox Error$, 16, "AddAllToList"
         AddAllToList = False
         Resume Bye_AddAllToList
End Function
Function ChangeQDef(Q As String, strSQL As String)
On Error GoTo Err_ChangeQDef
'Changes the SQL of the query Q to strSQL
    Dim qd As QueryDef
    Set qd = CurrentDb.QueryDefs(Q)
    qd.SQL = strSQL
    Exit Function
    MsgBox Err.Description
    Resume Exit_ChangeQDef
End Function
Function IsObjectOpen(strName As String, Optional intObjectType As Integer = acForm) As Boolean
    'intObjectType can be:
    ' acTable (0)
    ' acQuery (1)
    ' acForm (2)
    ' acReport (3)
    ' acMacro (4)
    ' acModule (5)
    'Returns True if strName is open, False otherwise
    On Error Resume Next
        IsObjectOpen = (SysCmd(SYSCMD_GETOBJECTSTATE, intObjectType, strName) <> 0)
    If Err <> 0 Then
        IsObjectOpen = False
    End If
End Function
Function GetRedYellowGreen(dDate As Date) As Integer
On Error GoTo Err_GetRedYellowGreen
    GetRedYellowGreen = IIf(Nz([dDate], #1/1/2100#) > Date + 14, 0, IIf([dDate] > Date, 1, 2))
    Exit Function
    MsgBox "Module: Utilities, GetRedYellowGreen " & Err.Description
    Resume Exit_GetRedYellowGreen
End Function
Function GetNextECMNumber() As String
    Dim strSQL As String
    Dim rst As New ADODB.Recordset
    strSQL = "SELECT Max([ECMNumber]) AS MaxOfECMNumber " & _
             "FROM tbl_ECMs"
    rst.Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic
    GetNextECMNumber = "HFF-ECM-" & Format(Right(rst!MaxOfECMNumber, 4) + 1, "0000")
    Set rst = Nothing
End Function
Function GetNumberofRows(strSQL As String) As Double
    Dim rst As New ADODB.Recordset
    rst.Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic
    If rst.EOF Then
        GetNumberofRows = 0
        GetNumberofRows = rst.RecordCount
    End If
    Set rst = Nothing
End Function
Function FilterGeneric(strFilter As String) As String
On Error GoTo Err_FilterGeneric
    Dim frm As Form, ctl As Control
    Dim varItem As Variant
    Dim FilterString As String
    Set frm = Forms!frm_ECMs
    Set ctl = Forms!frm_ECMs(DLookup("[FilterFormControl]", "[tbl_Filters]", "[FilterName]= '" & strFilter & "'"))
    FilterString = ""
    'enumerate selected items and concatenate to strSQL
    For Each varItem In ctl.ItemsSelected
        If ctl.ItemData(varItem) = 0 Then
            FilterGeneric = ""
            Exit Function
            FilterString = FilterString & " " & DLookup("[FilterSQLWHEREClause]", "[tbl_Filters]", "[FilterName]= '" & strFilter & "'") & "= " & ctl.ItemData(varItem) & " OR "
        End If
    Next varItem
    If Nz(FilterString, "") = "" Then
        FilterGeneric = ""
        Exit Function
    End If
    'Trim the end of strSQL
    FilterString = Left$(FilterString, InStrRev(FilterString, "OR") - 2)
    FilterGeneric = FilterString
    Exit Function
    MsgBox Err.Description
    Resume Exit_FilterGeneric
End Function

Open in new window

Question by:Michael Vasilevsky
  • 2
LVL 28

Accepted Solution

TextReport earned 500 total points
ID: 24031957
In the code that contains the line with the error

Set RS = DB.OpenRecordset(C.RowSource, DB_OPEN_SNAPSHOT)

Endure the DIM for the RS variable is set to

DIM rs As DAO.Recordset

Also ensure you have a reference to the Microsoft DAO Library (probably versions 3.6). Go to VBA module, Tools Menu, References.

Cheers, Andrew
LVL 28

Expert Comment

ID: 24032003
Just seen it on line 29
Cheers, Andrew

         Static DB As DAO.Database, RS As DAO.Recordset
LVL 10

Author Comment

by:Michael Vasilevsky
ID: 24032156
That's it thanks! I had the library referenced, but needed to add DAO. in my declarations.

Featured Post

Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

It’s been over a month into 2017, and there is already a sophisticated Gmail phishing email making it rounds. New techniques and tactics, have given hackers a way to authentically impersonate your contacts.How it Works The attack works by targeti…
It’s the first day of March, the weather is starting to warm up and the excitement of the upcoming St. Patrick’s Day holiday can be felt throughout the world.
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

860 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question