VBA Code to keep Form open

mp231

New member
Local time
Tomorrow, 03:46
Joined
Aug 6, 2012
Messages
4
G'Day

I have a program that uses a vba routine to open a form in Access 2007. The operator can then enter dates into the form and print required information.

However as soon as the form opens the routine ends and Access immediately shuts down before the operator can enter the dates.

Is it normal for Access to close in this case if the routine ends or am I using an incorrect command.

I've been told that this used to work in Access 2003

Here is the vba code . Thanks for looking.



Sub Report
'Starts Access and opens "PrintForm" for inputting required data record day and printout Form

Dim DBPath As String

On Error Resume Next

DBPath = "C:\Documents and Settings\Administrator\My Documents\Database.mdb"

'Attempt to get any currently running Access object
Set MyAccessObject = GetObject(, "Access.Application")
If Err.Number = 429 Then 'If = 429, Access is not running
Set MyAccessObject = GetObject(DBPath) 'Get Access object
MyAccessObject.DoCmd.OpenForm "PrintForm", acNormal 'Opens the information input form
ElseIf Err.Number = 0 Then
MsgBox "Access is already running." & vbCrLf & vbCrLf & "Shutdown and restart to try again"
Else
MsgBox Err.Number & vbCrLf & Err.Description
End If
End Sub
 
The problem here is poorly implemented Error handling Function. Your code has this,
Code:
On Error Resume [COLOR=Red][B]Next[/B][/COLOR]
Which is not a great way to handle errors, you have to go to a error handling procedure. When you say Resume Next, what you are doing is just RELEASING the error handler FROM ITS DUTY TO REPORT ERROR and making it execute the next line without even trying to tackle it. Which is why it is jumping to the next line EXIT SUB. Technically the If statement, but we just asked the compiler to act as if nothing happened (No error !!) So none of the IF works, thus causing it to exit.
I have re-written your code, this way you will get what the error is..
Code:
Public Sub Report
    '[COLOR=YellowGreen]Starts Access and opens "PrintForm" for inputting required data record day and printout Form[/COLOR]
    Dim DBPath As String
    On Error Resume[COLOR=Red] [/COLOR][COLOR=Red]errHandler[/COLOR]
    DBPath = "C:\Documents and Settings\Administrator\My Documents\Database.mdb"
    '[COLOR=YellowGreen]Attempt to get any currently running Access object[/COLOR]
    Set MyAccessObject = GetObject(, "Access.Application")
    [COLOR=DarkOrange]exitSub:[/COLOR]
        Exit Sub
    [COLOR=Red]errHandler:[/COLOR]
        If Err.Number = 429 Then 
            '[COLOR=YellowGreen]If = 429, Access is not running[/COLOR]
            Set MyAccessObject = GetObject(DBPath) 
            '[COLOR=YellowGreen]Get Access object[/COLOR]
            MyAccessObject.DoCmd.OpenForm "PrintForm", acNormal 
            '[COLOR=YellowGreen]Opens the information input form[/COLOR]
        ElseIf Err.Number = 0 Then
            MsgBox "Access is already running." & vbCrLf & vbCrLf & "Shutdown and restart to try again"
        Else
            MsgBox Err.Number & vbCrLf & Err.Description
        End If
        Resume [COLOR=DarkOrange]exitSub[/COLOR]
End Sub
 
Thanks Paul

My compiler returned an error at
....On Error ResumeerrHandler
I changed it to
....On Error GoTo errHandler
and it seems to work.

Will this be Ok ?

Also I found that the instruction
MyAccessObject.usercontrol=true
before exiting the routine is what I needed to keep Access from closing.

Thanks Again
 

Users who are viewing this thread

Back
Top Bottom