PDA

View Full Version : With keyword triggers Class_Terminate



tbaker818
10-12-2015, 11:30 AM
This code doesn't behave the way I'd expect:

Set Project = New cProject
With Project

The first line triggers the Class_Initialize event, but the second triggers Class_Terminate - not at all what I'd expect. Why would this occur? How can I avoid other than avoiding With?

SamT
10-12-2015, 12:22 PM
"With Project" is not the problem. The problem is in the cProject code

tbaker818
10-12-2015, 12:31 PM
OK, so the code that runs with the first line is here:

Private Sub Class_Initialize()
On Error Resume Next
Set mpjProjApp = GetObject(, "MSProject.Application")

If Err.Number <> 0 Then
Shell "winproj.exe /s http://myteams.directv.com/dtvepi"
Do Until Not (mpjProjApp Is Nothing)
DoEvents
Set mpjProjApp = GetObject(, "MSProject.Application")
Loop
On Error GoTo 0
Else
On Error GoTo 0
mbProjectRunning = True
If mpjProjApp.Profiles.ActiveProfile.Type = pjLocalProfile Then
Set mpjProjApp = New MSProject.Application
End If
End If
mpjProjApp.DisplayAlerts = False
mpjProjApp.Visible = True
End Sub

What would be causing the terminate event on the With later?

SamT
10-12-2015, 03:55 PM
On Error GoTo 0 disables error handling and you never want to do that until you have dealt with (handled) all errors.

Actually, I don't understand the process in that code.
First you set mpjProjApp to Project Application

If that fails, you open MS Project to a web page AND try again to set mpjProjApp to Project Application

Else If it succeeded you check the active profile AND reset mpjProjApp to Project Application

Try this. If it works, we can improve it. See if you can "With Project" on it.

Option Explicit



Private Sub Class_Initialize()

Dim mpjProjApp As Object

On Error GoTo ErrHandler
Set mpjProjApp = GetObject(, "MSProject.Application")

If mpjProjApp Is Nothing Then GoTo ErrHandler

mbProjectRunning = True
mpjProjApp.DisplayAlerts = False 'Caution recommended
mpjProjApp.Visible = True
Exit Sub

ErrHandler:
With Err
MsgBox "An Error occured while Intializing the Class!" & _
vbCr & "The error number was: " & .Number & _
vbCr & "and the Errorr was: " & .Desription
End With
End 'Stop all code and activity in Application
End Sub

tbaker818
10-12-2015, 06:41 PM
OK, thank you. I see your point on the error handling. I should have explained, there is a method to that madness. It's having to deal with the potential for Project to be open or closed and in local or server modes. I actually got that method out of a book. Anyway, the thing mysteriously stopped the behavior where it was terminating the class module. I've seen some other odd behavior with those today but have since rebooted.

SamT
10-13-2015, 12:15 AM
When you know that MS Project is not open run this. You'll need to edit it for specificity.


Sub GetProjectTaskID()
Dim ProJectTasdkID as Variant

ProjectTaskID = Shell("C:\Program Files\Microsoft Office\...\Project.Exe", vbNormalNoFocus)

Range("A1") = ProjectTaskID
End Sub

Format A1 as General so it will show all decimal places.

Then Set up a Global Const ProjectTaskID As Variant = in your VBA Project and copy A1 to the Value of that Constant

Then

Private Function MSProjectIsOpen() As boolean

On Error GoTo NotOpen
AppActivate ProjectTaskID
MSProjectIsOpen = True
Me.Activate
Exit Function

NotOpen:
End Function

snb
10-13-2015, 01:45 AM
that's classic:


On Error resume next
Set mpjProjApp = GetObject(, "MSProject.Application")
if mpjProjApp is nothing then mpjProjApp=createobject("MSProject.Application")

or


Sub M_snb()
On Error Resume Next

With GetObject(, "MSProject.application")
If Err.Number <> 0 Then
With CreateObject("MSProject.application")

.Quit
End With
End If
End With
End Sub

Paul_Hossler
10-13-2015, 06:25 AM
On Error GoTo 0 disables error handling and you never want to do that until you have dealt with (handled) all errors.

I think that is a typo and should be 'On Error Resume Next'

However, "you never want to do that until you have dealt with (handled) all errors." is still absolutely true

Aflatoon
10-13-2015, 06:27 AM
I don't think so. OERN suppresses errors (which is a form of error handling) but OEG0 does disable error handling. (it doesn't clear the current exception though, if any)

SamT
10-13-2015, 08:14 AM
On Error resume Next
Set mpjProjApp = GetObject(, "MSProject.Application")
If mpjProjApp Is Nothing Then mpjProjApp=createobject("MSProject.Application")

That makes sense and is so obvious that, it gave me a mini-epiphany and I now understand the logic behind the OP's Code.

@ tbaker,

So the code logic of your first sample is

Check If Project is running,
If Not Then Open it and use the the new running instance as Profile = Server
Else If it's running as Profile =local Then create a new instance (as Profile = Local?)

The questions are because I am pretty sure that Set mpjProjApp = New MSProject.Application will be with a Profile = Local, But opening Project with Shell "winproj.exe /s http://myteams.directv.com/dtvepi" will run it as Profile = Server. :dunno

So the question is: How do you want to use MS Project in your cProject Class?

Paul_Hossler
10-13-2015, 09:53 AM
I don't think so. OERN suppresses errors (which is a form of error handling) but OEG0 does disable error handling. (it doesn't clear the current exception though, if any)

Possible interpretation difference ??

OERN doesn't really 'suppress errors', it ignores them and just goes to the next line ('If Err.Number <> 0' in this case

OEG0 disables any error handler and allows r/t errors to halt the prog

I much prefer the SamT approach in #4 with an identified error handler, since the original code ...



Do Until Not (mpjProjApp Is Nothing)
DoEvents
Set mpjProjApp = GetObject(, "MSProject.Application")
Loop



... looks like a potential infinite loop waiting to happen

"Po-ta-toes, Pa-ta-toes" :thumb (OK, that was really bad Paul)

tbaker818
10-13-2015, 11:02 AM
Thanks for #6 Sam, the problem is ProjectTaskID changes every time, so I'm stuck with Shell Out and wait, leaving me with the "infinite loop" as Paul mentioned. I put a timer limit on it to get around this. Thanks everyone!