Solved

Type Mismatch with AddAlltoList

Posted on 2009-03-31
3
550 Views
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)
                  Else
                     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.
               RS.MoveLast
               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
                  Else
                     ' Otherwise, return NULL.
                     AddAllToList = Null
                  End If
               Else
                  ' Grab the record and field for the specified row/column.
                  RS.MoveFirst
                  RS.Move Row - 1
                  AddAllToList = RS(Col)
               End If
            Case LB_END
               DISPLAYID = 0
               RS.Close
         End Select
 
Bye_AddAllToList:
         Exit Function
 
Err_AddAllToList:
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_ChangeQDef:
    Exit Function
 
Err_ChangeQDef:
    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_GetRedYellowGreen:
    Exit Function
 
Err_GetRedYellowGreen:
    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
    rst.MoveFirst
    GetNextECMNumber = "HFF-ECM-" & Format(Right(rst!MaxOfECMNumber, 4) + 1, "0000")
    
    rst.Close
    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
    rst.MoveFirst
    If rst.EOF Then
        GetNumberofRows = 0
    Else
        GetNumberofRows = rst.RecordCount
    End If
    
    rst.Close
    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
        Else
            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_FilterGeneric:
    Exit Function
 
Err_FilterGeneric:
    MsgBox Err.Description
    Resume Exit_FilterGeneric
End Function

Open in new window

0
Comment
Question by:Michael Vasilevsky
[X]
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
3 Comments
 
LVL 28

Accepted Solution

by:
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
0
 
LVL 28

Expert Comment

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

         Static DB As DAO.Database, RS As DAO.Recordset
0
 
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.
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

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

Suggested Solutions

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…
This article describes a method of delivering Word templates for use in merging Access data to Word documents, that requires no computer knowledge on the part of the recipient -- the templates are saved in table fields, and are extracted and install…
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.
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…

739 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