Solved

vb6 and MsWord - Checking to see if word is running

Posted on 2014-04-01
23
541 Views
Last Modified: 2014-04-11
Hi Guys

Using vb6 and MSWord - how can I check if word is already running? Currently I use the following function and would like to see if it can be tidied up avoiding the use of on error resume next if possible.

Function IsWordActive()
On Error Resume Next
If wrdApp.Name <> "" Then
'    Debug.Print wrdApp.Name
End If

If Err.Number = 462 Or 91 Then
    Err.Clear
    With wrdApp
        Set wrdApp = GetObject(Class:="Word.Application")
        If Err.Number <> 0 Then
            Set wrdApp = CreateObject("Word.Application")
        End If
    End With
End If

wrdApp.Visible = False

On Error GoTo 0

End Function

Open in new window


MTIA

DWE
0
Comment
Question by:dwe0608
  • 10
  • 7
  • 5
23 Comments
 
LVL 14

Assisted Solution

by:DrTribos
DrTribos earned 200 total points
ID: 39971062
I think that is about the cleanest way to do it.

I use this for Excel:
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")

If err Then
    err.Clear
    bstartapp = True
    Set xlapp = CreateObject("Excel.Application")
End If

On Error GoTo 0

Open in new window

0
 
LVL 14

Expert Comment

by:DrTribos
ID: 39971077
Incidently I was thinking along similar lines and started reading a lot on error handling - it turns out sometimes testing for an error is the cleanest way to do things, see point 4 in this article.
0
 
LVL 1

Author Comment

by:dwe0608
ID: 39971177
Hi Guys

I've come up with the following improved function:

'******************************************************************************
' Checks to see if Word is open, if not it cranks it up otherwise...sweeeet as
' DWE - 02/04/2014
'******************************************************************************
Function IsWordActive()
    On Error Resume Next ' we we can catch error initially
    If IsObject(wrdApp) Then
        ' thrown in to case an error if the object is not instanciated as a word application
        If wrdApp.Name <> "" Then
    '    Debug.Print wrdApp.Name
        End If
    End If
    
ErrorCase:
    
    Select Case Err.Number
        Case 462 ' the remote server (the word application) doesnt exist
            Err.Clear
            Set wrdApp = GetObject(Class:="Word.Application")
            If Err.Number <> 0 Then GoTo ErrorCase
        Case 91
            Err.Clear
            Set wrdApp = CreateObject("Word.Application")
            If Err.Number <> 0 Then GoTo ErrorCase
        Case Else
            GoTo ErrHandler
    End Select
    
    If IsObject(wrdApp) Then
        wrdApp.Visible = False
    End If
    
NoError:
        Exit Function
ErrHandler:
            Call ClsErrorHandler("IsWordActive", "", True, False)
            GoTo NoError
End Function

'**********************************************************************
' included following function as it is referenced in the primary function
' and allows testing - also contains a neat routine to write to a error log 
'
Public Sub ClsErrorHandler(m_ProcedureName As String, Optional strCustomError As String = "", Optional bShowMsgBox As Boolean = False, Optional bIsFatal As Boolean = False)
    'Generic Error handling routine

    Dim handleErr As String
    Dim textfile As String

    'Raise the event according the procedure passed. Will write all errors
    'to an error log. Errors on the form will only be visible if
    'the event is active and a debug.print statement or message box
    'is inserted
    
    'Log the errors to an error log
    textfile = App.Path & "\ErrogLog.txt"
    handleErr = "Error: " & Err.Number & " " & Err.Description & " " & Err.Source & " Custom: " & strCustomError

    Open textfile For Append As #1 'write error to textfile
        Write #1, Now; handleErr; m_ProcedureName
    Close #1
    
    If bShowMsgBox Then
        Dim iResult As VbMsgBoxResult
        Dim msgboxQ$
        Dim msgboxI As VbMsgBoxStyle
        
        If Not bIsFatal Then
            msgboxQ = handleErr & vbCrLf & vbCrLf & vbCrLf & "Continue ?"
            msgboxI = vbYesNo + vbCritical
        Else
            msgboxQ = handleErr & vbCrLf & vbCrLf & vbCrLf & "The program will now end."
            msgboxI = vbCritical
        End If
        
        iResult = MsgBoxEx(msgboxQ, msgboxI)
        If iResult = vbNo Then
            MsgBox "Program will now end.", vbOKOnly
            End
        Else
        '    MsgBox iResult
        End If
    End If
    
    Err.Clear

End Sub

Open in new window


Can this code be improved and or condensed?

MTIA

DWE
0
 
LVL 1

Author Comment

by:dwe0608
ID: 39971207
DrTribos - didnt see you message before ... hadnt refreshed my screen or email ... am on NBN here and well, I save my bandwidth :-)
0
 
LVL 14

Expert Comment

by:DrTribos
ID: 39971209
Just looking at the top bit...  it seems if word is already open then the code will set .visible to false?  (is that desireable)

Also...
            Set wrdApp = GetObject(Class:="Word.Application")
            Set wrdApp = CreateObject("Word.Application")

Open in new window

If either of these lines are capable of creating the same error condition that brought you to them you'd get a loop.  I have not tested but generally in these cases I set a boolean flag to bail if I come unexpectedly to the same place twice, eg.: If IWasHere then Goto SafeExit  

And just for my edification (it's why I'm here) was there a reason you decided to / needed to put the remainder into a clsModule?  I've not done much with clsModules but seem that would work just the same in a normal module, I'm yet to test.
0
 
LVL 14

Expert Comment

by:DrTribos
ID: 39971210
Errm I wouldathought NBN was good for it, not rating it or tounge in cheek?
0
 
LVL 1

Author Comment

by:dwe0608
ID: 39971225
In my case I set visible to false to cater for the fact I do a lot work on the document and then show it at the conclusion of the code.

you're right in one sense about the loop but when you think of it logically, you can only get each of those errors once and if another is thrown in, then the select case statement bails you out by sending you to the errHandler label ...


I have all of this code in a user control ... that way I can use it in a number of different forms without rewriting any part of the code.

When word is being used in a user control, it seems to be very very touchy feely and doesnt like any errors around - one of the reasons I am looking at trying to get away from using on error resume next - my current code throws a number of errors on Win7, with VB6 and Word 2007 all of which relate to the on error resume next statement - but only when compiled - operates in the VB-IDE perfectly ...

hmmmm NBN ... not the satellite version sometimes I am better of walking up a hill with my laptop and USB modem ... no optical cable out here ...

There is no PM here on EE is there?
0
 
LVL 14

Expert Comment

by:DrTribos
ID: 39971248
Nope, and it does not seem to be on the radar either.... I have been meaning to for a while so added an email addy to my Bio.
0
 
LVL 1

Author Comment

by:dwe0608
ID: 39971457
ok - code improved a little more ...

'******************************************************************************
' Checks to see if Word is open, if not it cranks it up otherwise...sweeeet as
' DWE - 02/04/2014
'******************************************************************************
Function IsWordActive()

' Use CreateObject when there is no current instance of the object.
' If an instance of the object is already running, a new instance is started,
' and an object of the specified type is created.
' To use the current instance, or to start the application and have it load a file,
' use the GetObject function

 '   On Error Resume Next ' we we can catch error initially
 On Error GoTo ErrorCase:
 
 If IsObject(wrdApp) And wrdApp Is Nothing Then
    Set wrdApp = GetObject(Class:="Word.Application") ' see if word already in memory - if so get a reference to it?
 End If
    
ErrorCase:
    
    Select Case Err.Number
        Case 0 ' got what we want
            Err.Clear
            GoTo NoError
        Case 462 ' the remote server (the word application) doesnt exist
            Err.Clear
            Set wrdApp = GetObject(Class:="Word.Application")
            If Err.Number <> 0 Then GoTo ErrorCase
        Case 91
            Err.Clear
            Set wrdApp = CreateObject("Word.Application")
            If Err.Number <> 0 Then GoTo ErrorCase
            
        Case 429
            Err.Clear
            Set wrdApp = CreateObject("Word.Application")
            If Err.Number <> 0 Then GoTo ErrorCase
        Case Else
            GoTo ErrHandler
    End Select

NoError:
        wrdApp.Visible = False

ExitLabel:
        Exit Function
ErrHandler:
            Call ClsErrorHandler("IsWordActive", "", True, False)
            GoTo ExitLabel
End Function


Private Sub UserControl_Initialize()
' load word
 On Error GoTo ErrHandler:
Debug.Print "UserControl_Initialize - " & Now
IsWordActive

NoError:

    Exit Sub
ErrHandler:
    
        Call ClsErrorHandler("rptCtl_Initialize", "", True, False)
        GoTo NoError

End Sub

Open in new window


Can this be improved again ?
0
 
LVL 76

Assisted Solution

by:GrahamSkan
GrahamSkan earned 300 total points
ID: 39971523
Morning (:>) lads.
I like to keep the error suppression as short as possible. This keeps it to a single line:
Sub EditDoc()
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim bNewInstance As Boolean
    
    'try to use existing instance of application
    On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
    On Error GoTo 0
        
    If wdApp Is Nothing Then
        'no existing application, so create a new one
        Set wdApp = CreateObject("Word.Application")
        bNewInstance = True
    End If
    wdApp.Visible = True

    Set wdDoc = wdApp.Documents.Open("C:\MyFolder\Mydoc.doc")
    
    With wdDoc
        .'do some edits here
        .Close wdSaveChanges
    End With
    
    'close application if specially created for this code
    If bNewInstance Then
        wdApp.Quit
    End If
End Sub

Open in new window

0
 
LVL 76

Assisted Solution

by:GrahamSkan
GrahamSkan earned 300 total points
ID: 39971559
Note that you can use the FindWindow API function.
Option Explicit


Private Declare Function FindWindow Lib "user32" Alias _
    "FindWindowA" (ByVal strClass As String, _
    ByVal lpWindow As String) As Long

    

Sub Test()
    MsgBox "Word is " & IIf(IsWordRunning(), "", "not ") & "running"
End Sub
    
Function IsWordRunning() As Boolean
    Dim hWnd As Long
    
    hWnd = FindWindow("OpusApp", vbNullString)
    If hWnd <> 0 Then
        IsWordRunning = True
    End If
End Function

Open in new window

"OpusApp" is the class name for the Word Application
0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 1

Author Comment

by:dwe0608
ID: 39971567
hi GrahamSkan, obviously you're on the otherside of the world - 6pm here ...

I am using vb6, word 2007 on a 64bit version of Windows 7 professional

I am having trouble with vb6 crashing on every error, but only in the compiled exe file - not in the VB-IDE. The crash code is always error 0 and I am back tracking the errors, through manipulating the code in a fashion avoiding the use of on error resume next, because thats where the erors seem to be emanating from mainly - if I handle the error, then I seem to bypass the error 0 for that section of code.

I am not sure if its a 64 bit issue and I am currently investigating that as well.
0
 
LVL 14

Expert Comment

by:DrTribos
ID: 39971651
Just got home, nice one Graham :-)
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39971654
I am running a similar configuration, but with both Office 2003 and 2007 installed.

The .exe doesn't crash, but the code insists on opening Word 2003 instead of 2007, so it's not a fair test.
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39971660
Hi Steve, how are you and Nicole?
0
 
LVL 1

Author Comment

by:dwe0608
ID: 39971661
We'll get to the bottom of it ... the other thing I might not have mentioned is that my code resides in a usercontrol compiled with exe (ie not an OCX), so that might be making a difference as well.
0
 
LVL 1

Accepted Solution

by:
dwe0608 earned 0 total points
ID: 39971874
Well I made it to the end - no runtime errors and exe works fine.

Thanks for the input guys.

This is the completed function I decided to settle on:

'******************************************************************************
' Checks to see if Word is open, if not it cranks it up otherwise...sweeeet as
' DWE - 02/04/2014
'******************************************************************************
Function IsWordActive(Optional bUnloading As Boolean = False)
' Use CreateObject when there is no current instance of the object.
' If an instance of the object is already running, a new instance is started,
' and an object of the specified type is created.
' To use the current instance, or to start the application and have it load a file,
' use the GetObject function

 '   On Error Resume Next ' we we can catch error initially
 On Error GoTo ErrorCase:
 
'Test to see if we have a previous instance
 If IsObject(wrdApp) And wrdApp Is Nothing Then
    ' if not - test to see if word is running
    Set wrdApp = GetObject(Class:="Word.Application") ' see if word already in memory - if so get a reference to it?
    ' a catchable error is thrown if there is no previous instance - you could avoid this by loading a document at the same time - like a blank word document as follows:
        '    Set wrdApp = GetObject("c:\blank.doc", "Word.Application")
' or even
        '    Set wrdApp = GetObject("c:\blank.doc")
' which would start the word application  (provided thats what you have as your default word processor
 
 End If
    
ErrorCase:
    Select Case Err.Number
        Case 0 ' got what we want
            Err.Clear
            GoTo NoError
        Case 462 ' the remote server (the word application) doesnt exist
            Err.Clear
            Set wrdApp = GetObject(Class:="Word.Application")
            If Err.Number <> 0 Then GoTo ErrorCase
        Case 91
            Err.Clear
            Set wrdApp = CreateObject("Word.Application")
            If Err.Number <> 0 Then GoTo ErrorCase
        Case 429
            Err.Clear
            Set wrdApp = CreateObject("Word.Application")
            If Err.Number <> 0 Then GoTo ErrorCase
        Case Else
            GoTo ErrHandler
    End Select
NoError:
        wrdApp.Visible = True
ExitLabel:
        Exit Function
ErrHandler:
            Call ClsErrorHandler("IsWordActive", "", True, False)
            GoTo ExitLabel
End Function
'****
' Helper function
'****
Public Sub ClsErrorHandler(m_ProcedureName As String, Optional strCustomError As String = "", Optional bShowMsgBox As Boolean = False, Optional bIsFatal As Boolean = False)
    'Generic Error handling routine

    Dim handleErr As String
    Dim textfile As String

    'Raise the event according the procedure passed. Will write all errors
    'to an error log. Errors on the form will only be visible if
    'the event is active and a debug.print statement or message box
    'is inserted
    
    'Log the errors to an error log
    textfile = App.Path & "\ErrogLog.txt"
    handleErr = "Error: " & Err.Number & " " & Err.Description & " " & Err.Source & " Custom: " & strCustomError

    Open textfile For Append As #1 'write error to textfile
        Write #1, Now; handleErr; m_ProcedureName
    Close #1
    
    If bShowMsgBox Then
        Dim iResult As VbMsgBoxResult
        Dim msgboxQ$
        Dim msgboxI As VbMsgBoxStyle
        
        If Not bIsFatal Then
            msgboxQ = handleErr & vbCrLf & vbCrLf & vbCrLf & "Continue ?"
            msgboxI = vbYesNo + vbCritical
        Else
            msgboxQ = handleErr & vbCrLf & vbCrLf & vbCrLf & "The program will now end."
            msgboxI = vbCritical
        End If
        
        iResult = MsgBoxEx(msgboxQ, msgboxI)
        If iResult = vbNo Then
            MsgBox "Program will now end.", vbOKOnly
            End
        Else
        '    MsgBox iResult
        End If
    End If
    
    Err.Clear

End Sub

Open in new window


HTH someone else at some stage because its taken a while to get here ...
0
 
LVL 1

Author Comment

by:dwe0608
ID: 39971899
GrahamScan, the FindWindow functionality is a great way to find the window if its still opensomewhere ... but given that it relies upon user32, and I dont know the difference between the 32bit and 64 bit ...I opted not to rely upon it ...

Regards

DWE
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39971916
The User32 library will be available for a very long time yet - as long as programs compiled from VB6 and other 32 bit development applications are expected to run. I haven't tried User64, but if it is used, your project is unlikely to run on any 32 bit systems.
0
 
LVL 14

Expert Comment

by:DrTribos
ID: 39972096
Hi Graham, we're good. Wedding is less than 4 weeks now!  I think I still owe you some pics. Will catch up later :-/
0
 
LVL 1

Author Comment

by:dwe0608
ID: 39984211
Hi graham thats what I thought I did ... share the points and close the question ...
0
 
LVL 1

Author Closing Comment

by:dwe0608
ID: 39993642
I've shared the points as best I can - the level of participation in this question - is what I like to see in this forum and makes it an enjoyable place to come get help ... thanks guys ...
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Introduction This tutorial provides instructions on how to properly format your Word document using the inbuilt tools provided. The benefits of using these tools means your documents are more accessible and easily portable to other applications an…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
This video shows where to find templates, what they are used for, and how to create and save a custom template using Microsoft Word.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

760 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

20 Experts available now in Live!

Get 1:1 Help Now