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

x
?
Solved

Type Mismatch with AddAlltoList

Posted on 2009-03-31
3
Medium Priority
?
567 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 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
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

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