?
Solved

Type Mismatch with AddAlltoList

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

Technology Partners: 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

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…
Code that checks the QuickBooks schema table for non-updateable fields and then disables those controls on a form so users don't try to update them.
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …
Suggested Courses

764 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