检查Word文件是否已经打开VBA

时间:2018-11-27 14:30:15

标签: excel vba excel-vba ms-word

在打开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

那为什么只有第一个文档引起关注?

1 个答案:

答案 0 :(得分:0)

这是可行的-终于,我花了几个小时找到解决方案。但是我仍然错过了以下问题的答案:

我网络中的用户正在从服务器打开Word文件-如何在VBA中找出哪个用户打开了(并保持ist打开)?

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