检查word文件是否已经打开vba

Question

在打开Word文件之前，我想检查该文件是否已经打开。 （同时打开更多word文件） 主子调用这个函数来告诉我它是否打开。

Function FileInWdOpen(DokName As String) As Boolean                 

    Dim wd As Word.Application
    Dim wDoc As Word.Document

    On Error Resume Next                                            
    Set wd = GetObject(, "Word.Application")
    On Error GoTo NO_WORD_FOUND                                     

    If wd Is Nothing Then                                           
        FileInWdOpen = False
    End If

    For Each wDoc In wd.Documents        'should check for every open word file but doesn't do that                         
        If wDoc.Name = DokName Then      'checks if this file is named like the one I want to check if its open or not                           
            FileInWdOpen = True
            Exit Function                                           
        End If
    Next                                                            

    FileInWdOpen = False                                            

    Exit Function

NO_WORD_FOUND:       

    FileInWdOpen = False                                            

End Function

当仅打开一个单词文件时，此代码效果很好。如果打开两个或更多文件，则该脚本不起作用。

问题是 for 循环只检查第一个打开的文件。

我不明白为什么它不检查所有打开的文件。 我认为可以通过以下方式访问所有文档：

Dim WordApp As Word.Application                 'sets an var for the Word Application
Set WordApp = GetObject(, "Word.Application")   'give the var an obj, in this case the Word Application

Dim WordDoc As Word.Document                    'sets an var for the singel Word Documents
For Each WordDoc In WordApp.Documents           'for each Document in Dokuments
    'code
Next

那么为什么只有第一个文档受到关注？

Answer 1

这个有效 - 最后，我花了几个小时才找到解决方案。

Function FileInWordOpen(DokName As String) As Boolean
Dim wd As Word.Application
Dim wDoc As Word.Document
Dim i As Long, s As String
On Error Resume Next
Set wd = GetObject(, "Word.Application")
On Error GoTo NO_WORD_FOUND
If wd Is Nothing Then
    FileInWordOpen = False
End If
For i = 1 To wd.Documents.Count
    s = wd.Documents(i)
    If InStr(DokName, s) <> 0 Then
        FileInWordOpen = True
        Exit Function
    End If
Next

'For Each wDoc In wd.Documents        'should check for every open word file but doesn't do that
'    If wDoc.Name = DokName Then      'checks if this file is named like the one I want to check if its open or not
'        FileInWdOpen = True
'        Exit Function
'    End If
'Next

NO_WORD_FOUND:
    FileInWordOpen = False

End Function


Function GetOpenWordDoc(DokName As String) As Word.Document
    Dim wd As Word.Application
    Dim wDoc As Word.Document
    Dim i As Long, s As String
    On Error Resume Next
    Set wd = GetObject(, "Word.Application")
    On Error GoTo NO_WORD_FOUND
    If wd Is Nothing Then
        Set GetOpenWordDoc = Nothing
    End If
    For i = 1 To wd.Documents.Count
        s = wd.Documents(i)
        If InStr(DokName, s) <> 0 Then
            Set GetOpenWordDoc = wd.Documents(i)
            Exit Function
        End If
    Next

NO_WORD_FOUND:
    Set GetOpenWordDoc = Nothing
    
End Function

Answer 2

答案取决于搜索是从 Word 的活动实例还是从 Excel 等其他应用程序执行。全局变量

Application

指的是当前的 Word 实例，

Application.Documents

属性包含打开文档的集合。您可以按索引或全名引用文档。因此，如果您从当前 Word 实例内部检查，以下函数都会测试字符串

FullDocName

是否是打开的文档之一的全名。在这种情况下，您不得调用

GetObject

函数。

Function FileInWordOpen(FullDocName As String) As Boolean
  
  Dim wDoc As Word.Document
  FileInWordOpen = False
  
  For Each wDoc In Application.Documents
   
    If (wDoc.FullName = FullDocName) Then
      FileInWordOpen = True
      Exit Function
    End If
    
  Next

End Function

Function FileInWordOpen1(FullDocName As String) As Boolean
  
  FileInWordOpen1 = False
  
  On Error GoTo Err
  If Not (Application.Documents(FullDocName) Is Nothing) Then
    FileInWordOpen1 = True
    Exit Function
  End If
  
Err: FileInWordOpen1 = False
End Function

如果从 Excel 或 Access 等其他应用程序运行检查，代码会变得更加复杂，因为您必须首先检查 Word 实例是否打开，然后，如果是这种情况，则使用 GetObject 获取对此实例的引用功能。将此引用保存在全局变量中是有意义的。

Dim WordApp As Word.Application

Function IsWordOpen() As Boolean
  IsWordOpen = False
  Set WordApp = Nothing
  On Error GoTo Err
    
  ' Open the active Word Instance
  Set WordApp = GetObject(, "Word.Application")
  If (WordApp Is Nothing) Then
    Debug.Print "No instance of Word is open!"
  Else
    IsWordOpen = True
  End If
  
  Exit Function
  
Err:
  Debug.Print "IsOpenWord has messed it up!"
  IsWordOpen = False

End Function

Function FileInWordOpen(FullDocName As String) As Boolean
  
  Dim Doc As Word.Document
  FileInWordOpen = False
  
  If (IsWordOpen() = False) Then Exit Function
    
  For Each Doc In WordApp.Documents
   
    If (Doc.FullName = FullDocName) Then
      FileInWordOpen = True
      Exit Function
    End If
    
  Next

End Function

Function FileInWordOpen1(FullDocName As String) As Boolean
  FileInWordOpen1 = False
  
  If (IsWordOpen() = False) Then Exit Function
  
  On Error GoTo Err
  If Not (WordApp.Documents(FullDocName) Is Nothing) Then
    FileInWordOpen1 = True
    Exit Function
  End If
  
Err: FileInWordOpen1 = False
End Function