1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Access 2003: VBA connection error

Discussion in 'Business Applications' started by Zack Barresse, Apr 9, 2008.

Thread Status:
Not open for further replies.
Advertisement
  1. Zack Barresse

    Zack Barresse Thread Starter

    Joined:
    Jul 25, 2004
    Messages:
    5,452
    Hi,

    Have a problem with a database in the switchboard VBA module with an error on this line...

    Code:
        Set con = Application.CurrentProject.Connection
    Here is the entire code...

    Code:
    Option Compare Database
    Option Explicit
    
    Private Sub Form_Open(Cancel As Integer)
    ' Minimize the database window and initialize the form.
    
        ' Move to the switchboard page that is marked as the default.
        Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
        Me.FilterOn = True
        
    End Sub
    
    Private Sub Form_Current()
    ' Update the caption and fill in the list of options.
    
        Me.Caption = Nz(Me![ItemText], "")
        FillOptions
        
    End Sub
    
    Private Sub FillOptions()
    ' Fill in the options for this switchboard page.
    
        ' The number of buttons on the form.
        Const conNumButtons = 10
        
        Dim con As Connection
        Dim rs As Recordset
        Dim stSql As String
        Dim intOption As Integer
        
        ' Set the focus to the first button on the form,
        ' and then hide all of the buttons on the form
        ' but the first.  You can't hide the field with the focus.
        Me![Option1].SetFocus
        For intOption = 2 To conNumButtons
            Me("Option" & intOption).Visible = False
            Me("OptionLabel" & intOption).Visible = False
        Next intOption
        
        ' Open the table of Switchboard Items, and find
        ' the first item for this Switchboard Page.
        
        
        
       '         Set con = Application.CurrentObjectName
    
        '                       Chad entered the next line to try and skip error that kept stopping this code
        '          Set con = CurrentProject.Connection
        'On Error Resume Next
        Set con = Application.CurrentProject.Connection
        
        
        stSql = "SELECT * FROM [Switchboard Items]"
        stSql = stSql & " WHERE [ItemNumber] > 0 AND [SwitchboardID]=" & Me![SwitchboardID]
        stSql = stSql & " ORDER BY [ItemNumber];"
        Set rs = CreateObject("ADODB.Recordset")
        rs.Open stSql, con, 1   ' 1 = adOpenKeyset
        
        ' If there are no options for this Switchboard Page,
        ' display a message.  Otherwise, fill the page with the items.
        If (rs.EOF) Then
            Me![OptionLabel1].Caption = "There are no items for this switchboard page"
        Else
            While (Not (rs.EOF))
                Me("Option" & rs![ItemNumber]).Visible = True
                Me("OptionLabel" & rs![ItemNumber]).Visible = True
                Me("OptionLabel" & rs![ItemNumber]).Caption = rs![ItemText]
                rs.MoveNext
            Wend
        End If
    
        ' Close the recordset and the database.
        rs.Close
        Set rs = Nothing
        Set con = Nothing
    
    End Sub
    
    Private Function HandleButtonClick(intBtn As Integer)
    ' This function is called when a button is clicked.
    ' intBtn indicates which button was clicked.
    
        ' Constants for the commands that can be executed.
        Const conCmdGotoSwitchboard = 1
        Const conCmdOpenFormAdd = 2
        Const conCmdOpenFormBrowse = 3
        Const conCmdOpenReport = 4
        Const conCmdCustomizeSwitchboard = 5
        Const conCmdExitApplication = 6
        Const conCmdRunMacro = 7
        Const conCmdRunCode = 8
        Const conCmdOpenPage = 9
    
        ' An error that is special cased.
        Const conErrDoCmdCancelled = 2501
        
        Dim con As Object
        Dim rs As Object
        Dim stSql As String
    
    On Error GoTo HandleButtonClick_Err
    
        ' Find the item in the Switchboard Items table
        ' that corresponds to the button that was clicked.
        Set con = Application.CurrentProject.Connection
        Set rs = CreateObject("ADODB.Recordset")
        stSql = "SELECT * FROM [Switchboard Items] "
        stSql = stSql & "WHERE [SwitchboardID]=" & Me![SwitchboardID] & " AND [ItemNumber]=" & intBtn
        rs.Open stSql, con, 1    ' 1 = adOpenKeyset
        
        ' If no item matches, report the error and exit the function.
        If (rs.EOF) Then
            MsgBox "There was an error reading the Switchboard Items table."
            rs.Close
            Set rs = Nothing
            Set con = Nothing
            Exit Function
        End If
        
        Select Case rs![Command]
            
            ' Go to another switchboard.
            Case conCmdGotoSwitchboard
                Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" & rs![Argument]
                
            ' Open a form in Add mode.
            Case conCmdOpenFormAdd
                DoCmd.OpenForm rs![Argument], , , , acAdd
    
            ' Open a form.
            Case conCmdOpenFormBrowse
                DoCmd.OpenForm rs![Argument]
    
            ' Open a report.
            Case conCmdOpenReport
                DoCmd.OpenReport rs![Argument], acPreview
    
            ' Customize the Switchboard.
            Case conCmdCustomizeSwitchboard
                ' Handle the case where the Switchboard Manager
                ' is not installed (e.g. Minimal Install).
                On Error Resume Next
                Application.Run "ACWZMAIN.sbm_Entry"
                If (Err <> 0) Then MsgBox "Command not available."
                On Error GoTo 0
                ' Update the form.
                Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
                Me.Caption = Nz(Me![ItemText], "")
                FillOptions
    
            ' Exit the application.
            Case conCmdExitApplication
                CloseCurrentDatabase
    
            ' Run a macro.
            Case conCmdRunMacro
                DoCmd.RunMacro rs![Argument]
    
            ' Run code.
            Case conCmdRunCode
                Application.Run rs![Argument]
    
            ' Open a Data Access Page
            Case conCmdOpenPage
                DoCmd.OpenDataAccessPage rs![Argument]
    
            ' Any other command is unrecognized.
            Case Else
                MsgBox "Unknown option."
        
        End Select
    
        ' Close the recordset and the database.
        rs.Close
        
    HandleButtonClick_Exit:
    On Error Resume Next
        Set rs = Nothing
        Set con = Nothing
        Exit Function
    
    HandleButtonClick_Err:
        ' If the action was cancelled by the user for
        ' some reason, don't display an error message.
        ' Instead, resume on the next line.
        If (Err = conErrDoCmdCancelled) Then
            Resume Next
        Else
            MsgBox "There was an error executing the command.", vbCritical
            Resume HandleButtonClick_Exit
        End If
        
    End Function
    This is a project I did a few years ago and another guy is in the position now and having issues. I don't know the Access VBA OM well enough to know why it is erroring out. Pretty sure it was programmed in 2003. Can anyone help debug this? Thanks.
     
  2. OBP

    OBP

    Joined:
    Mar 8, 2005
    Messages:
    19,895
    Zack, I get similar problems most of the time when I open other people's databases that use Access Switchboards.
    I have never used or Created a switchboard and it appears that when you do the switchboard wizard creates a seperate .dll file for it.
    I do not know if that bears any relation to your problem or not, but you could try generating another switchboard to see if that works and then test the one that you are having trouble with.
    Do you know what happens if you "Rem" out the offending line of code?
     
  3. Rollin_Again

    Rollin_Again

    Joined:
    Sep 4, 2003
    Messages:
    4,912
    What is the exact error message or error number?


    Regards,
    Rollin
     
  4. Zack Barresse

    Zack Barresse Thread Starter

    Joined:
    Jul 25, 2004
    Messages:
    5,452
    I'll have to check with the guy for the error message. It is an undefined object error though. It may be a DLL issue. This apparently was a reinstalled application. When I went to the Help files I received numerous DLL errors (MSDART.DLL I believe). I told him to try the database on another computers Access and if the problem went away to do a full reinstall on his machine. I'll check with the error message and get back to you.
     
  5. Rollin_Again

    Rollin_Again

    Joined:
    Sep 4, 2003
    Messages:
    4,912
    Any missing references showing?

    Regards,
    Rollin
     
  6. Zack Barresse

    Zack Barresse Thread Starter

    Joined:
    Jul 25, 2004
    Messages:
    5,452
    I will ask on that. :)
     
  7. Zack Barresse

    Zack Barresse Thread Starter

    Joined:
    Jul 25, 2004
    Messages:
    5,452
    The guy did not check references (tried to in run-time), so I've asked him to re-check and walked him through how. This is an email I received from him from some questions I asked....

     
  8. Sponsor

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/702113

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice