Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win


Type Mismatch with AddAlltoList

Posted on 2009-03-31
Medium Priority
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
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
  • 2
LVL 28

Accepted Solution

TextReport earned 2000 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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Preparing an email is something we should all take special care with – especially when the email is for somebody you may not know very well. The pressures of everyday working life stacked with a hectic office environment can make this a real challen…
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.

604 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