Determine if word document is open

[UHsoccer]

I am using Excel 2003 to create word documents. The starter word doc has codes that get replaced and I then do a save-as

When the starter document is already open, it gets corrupted when I try to open it with VB.

How can I determine if a specific word document is already open?

Here is some of the code to open it

Dim oWordApp As Object, openDoc as string
Set oWordApp = CreateObject("Word.Application")

'  check if already open -------------

openDoc = "C:\Temp\Start.doc

oWordApp.Documents.Open openDoc
oWordApp.Visible = True

Any advice appreciated

 

[BrianB]

This code traps the error produced by GetObject if Word is not open.

    '---------------------------------------
    On Error Resume Next
    '- try to get Word application
    Set xlApp = GetObject(, "Word.Application")
    If Err.Number Then ' Word is not open
        Set xlApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    '-------------------------------------------------

 

[UHsoccer]

Thanks for the answer, however your logic checks whether the "Word Apllication" is open.

I want to determine if the actual word document that I want to open is already opened by the user.

 

[Jon Peltier]

Function IsWordDocOpen(sWordDocFullName As String) as Boolean
    Dim wdApp as Object ' Late Binding - who cares?
    Dim wdDoc as Object

    IsWordDocOpen = False

    On Error Resume Next 
    '- try to get Word application 
    Set wdApp = GetObject(, "Word.Application") 
    If Err.Number Then ' Word is not open 
        Exit Function
    End If 
    On Error GoTo 0

    For Each wdDoc in wdApp.Documents
        If wddoc.FullName = sWordDocFullName Then
            IsWordDocOpen = True
            Exit Function
        End If
    Next

End Function

 

[UHsoccer]

Apologies to you John, did not see the reply.

Will implement tonight (it is a private project), will let you know tomorrow

 

[kkjensen]

Jon,

I've tried your function and have a few questions as I need to be able to use the same snippit of code.

1. You have it setup as a function; can it be called from another macro or do I need to make it a sub?

2. The For loop at the end where it cycles through all word documents doesn't run. I step up to the first line and it skips completely out. Is there anything else that needs to be set so this will work? I already have the reference for Word added. I've tried a similar bit of code from someone else and the same problem happens where it skips the entire FOR loop.

 

[Jon Peltier]

1. Call it as you would call any function from another procedure:

Dim bWordTest as Boolean
bWordTest = IsWordDocOpen("C:\temp\MyDoc.doc")

2. If the loop doesn't loop, it means there are no documents open.

 

[kkjensen]

Thanks.

I've tweaked it a bit to suit my needs (if word isn't open it opens it) but it comes back saying "Argument not optional" on the line I've marked. Is there a reason I wouldn't be able to fire up an instance of word here?

Sub ListPictureExport()

Dim WDApp As Object
Dim WDDoc As Object
Dim DocName As String
Dim DocPath As String
Dim FullDoc As String
Dim ReadyFlag As Boolean


'check if export list exists
On Error Resume Next
Application.Goto Reference:="HelperStart"
If Err.Number = 1004 Then
    MsgBox "export list doesn't exist"
    Exit Sub
End If
On Error GoTo 0

                                                                                                        
'Get file info
DocName = ActiveCell.Value & ".doc"
DocPath = ActiveCell.Range("A2").Value
FullDoc = DocPath & DocName
                                                    
'Check if Word is open
On Error Resume Next
Set WDApp = GetObject(, "Word.Application")
If Err.Number Then
    Set WDApp = CreateObject(, "Word.Application")    <--ERROR SHOWS UP HERE
    WDApp.Visible = True
End If
On Error GoTo 0

'Check if Document is open
ReadyFlag = IsWordDocOpen(FullDoc)

If Not (ReadyFlag) Then GoTo quickend


'etc etc




quickend:
Set WDApp = Nothing
Set WDDoc = Nothing
End Sub

 

[Jon Peltier]

Take out the comma in this line only (not in GetObject):

    Set WDApp = CreateObject("Word.Application")