Access 2003: VBA connection error

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Zack Barresse

Thread Starter
Joined
Jul 25, 2004
Messages
5,458
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.
 

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?
 

Zack Barresse

Thread Starter
Joined
Jul 25, 2004
Messages
5,458
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.
 

Zack Barresse

Thread Starter
Joined
Jul 25, 2004
Messages
5,458
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....

The error reads: Run-time error '-2147024769(8007007f)':
Method 'Connection' of object'_CurrentProject' failed

This is the same error that appears after selecting Debug and pressing F8.

When I go to the Tools menu, "references" is greyed out. I tried selecting and deselecting code and it is still greyed out. At one point I got it to work and nothing started with "missing". OK, I can repeat this. When "Debug" is selected, VB is opened with the problem code highlighted in yellow and references is not available. If I then close the database but leave open access, VB stays open. I then reopen the db, select debug and the already open VB screen now has all the code without highlight and references are available.

Only 8 items selected: VB for apps,
Ms access 11.0 object lib
ole automation
ms activex data objects 2.1 lib
ms calendar control 11.0
ms forms 2.0 object lib
ms office 11.0 object Lib
ms dao 3.6 object lib



The following is what the help button returns about the error:
Automation error (Error 440)

When you access Automation objects, specific types of errors can occur. This error has the following cause and solution:
&#8226; An error occurred while executing a method or getting or setting a property of an object variable. The error was reported by the application that created the object.
Check the properties of the Err object to determine the source and nature of the error. Also try using the On Error Resume Next statement immediately before the accessing statement, and then check for errors immediately following the accessing statement.
For additional information, select the item in question and press F1 (in Windows) or HELP (on the Macintosh).
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

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 807,865 other people just like you!

Latest posts

Members online

Top