如何检查Word文件是否从Excel VBA打开？

Question

I searched for the exact term in Google, it spits out multiple results. I tried al least 4-5 of them. None works. It is either all TRUE or all FALSE depending on the function, but it is never correct.

In addition to not understanding how those functions are supposed to work (which would be a secondary endpoint) I would be really grateful if someone could lead me to primary endpoint (which is checking if a Word document is open from Excel VBA)?

Thanks

Answer 1

Is Word File Open?

• A Word file cannot be open (in Word) if the Word application is not open.
• So first check if Word is open, then check if the file is open.

Is Word open?

Function IsWordOpen() As Boolean
    Dim wdApp As Object
    ' Attempt to reference the word application.
    On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
    On Error GoTo 0
    IsWordOpen = Not wdApp Is Nothing
End Function

Sub IsWordOpenTEST()
    Debug.Print IsWordOpen
End Sub

Reference Word

Function RefWord() As Object
    Dim wdApp As Object
    ' Attempt to reference the word application.
    On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
    On Error GoTo 0
    If Not wdApp Is Nothing Then Set RefWord = wdApp
End Function

Sub RefWordTEST()
    ' Reference the word application.
    Dim wdApp As Object: Set wdApp = RefWord
    If wdApp Is Nothing Then
        MsgBox "Word is not open", vbExclamation
        Exit Sub
    End If
    ' Print the names of open files.
    Dim wdDoc As Object
    For Each wdDoc In wdApp.Documents
        Debug.Print wdDoc.Name
    Next wdDoc
End Sub

Is Word file open?

' Uses the RefWord function.
Function IsWordFileOpen( _
    ByVal WordFileName As String) _
As Boolean
    Dim wdApp As Object: Set wdApp = RefWord
    If wdApp Is Nothing Then Exit Function
    
    Dim wdDoc As Object
    On Error Resume Next
        ' Attempt to reference the word document.
        Set wdDoc = wdApp.Documents(WordFileName)
    On Error GoTo 0
    IsWordFileOpen = Not wdDoc Is Nothing
End Function

Sub IsWordFileOpenTEST()
    Debug.Print IsWordFileOpen("Test.docx")
End Sub

Is Word file open (stand-alone)?

• Why did I post all those procedures above?
• When you run the following, if the result is True then you know the following:
  • Word is open,
  • a file named Test.docx is open.
• What you don't know is whether it is the correct file or another with the same name.
• If the result is False , it gets even worse ie then you don't know the following:
  • whether Word is open, or not
  • whether there is another instance of Word where the file is open, or not
  • whether another application has locked the file, or not...
• To conclude, depending on what you plan to do with this information, you will have to decide what to check ie be careful, this is just a basic approach.

' Stand-Alone
Function IsWordFileOpenCompact( _
    ByVal WordFileName As String) _
As Boolean
    Dim wdApp As Object
    ' Attempt to reference the word application.
    On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
    On Error GoTo 0
    If wdApp Is Nothing Then Exit Function
    
    Dim wdDoc As Object
    On Error Resume Next
        ' Attempt to reference the word document.
        Set wdDoc = wdApp.Documents(WordFileName)
    On Error GoTo 0
    IsWordFileOpenCompact = Not wdDoc Is Nothing
End Function

Sub IsWordFileOpenCompactTEST()
    Debug.Print IsWordFileOpenCompact("Test.docx")
End Sub