Solved

Type Mismatch with AddAlltoList

Posted on 2009-03-31
3
535 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
  • 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

Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

Question has a verified solution.

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

Suggested Solutions

The first two articles in this short series — Using a Criteria Form to Filter Records (http://www.experts-exchange.com/A_6069.html) and Building a Custom Filter (http://www.experts-exchange.com/A_6070.html) — discuss in some detail how a form can be…
Experts-Exchange is a great place to come for help with solutions for your database issues, and many problems are resolved within minutes of being posted.  Others take a little more time and effort and often providing a sample database is very helpf…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…

929 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now