需求与场景
 
 
 
在Excel的VBA中，打开Word文件是比较容易的，但判断某个word文件是否已经打开，则有些小坑需要注意。
 
 
因为工作需求，要把Excel中的数据写入到指定的word文件里（用链接的方式经常会出现word无响应的状况，而且数据量大的时候，打开速度实在太慢。），所以就研究了一下如何判断word文件是否被打开的情形。参考了一些资料，结合自己的理解，记录如下。
 
Excel VBA代码
 
① 首先要在ExcelVBA工程中引入word
 
工具-引用，选取MicroSoft Word xx.0 Object Library
 
②判断指定word文件是否打开（函数）
 
Function WordDocIsOpen(ByVal strDocName As String) As Boolean
    'objWordDocName 这个变量的目的是接收一下循环出来的objWordDoc的文件名，
    				'如果没有的话会导致if条件无法正确判断(office2010试验后结果）
    Dim objWordDocName As String 
    Dim objWordApp As Object
    Dim objWordDoc As Object
    On Error Resume Next '此句是关键，因为当word文件没有被打开时，会直接报错(GetObject：Run-time error '429':）
    strDocName = UCase(strDocName) '将文件名字母全部大写。注意：这个参数变量必须是全路径+文件名
    Set objWordApp = GetObject(, "Word.Application")
    For Each objWordDoc In objWordApp.Documents  '遍历当前在 Word 中打开的所有 Document 对象的集合
        objWordDocName = UCase(objWordDoc.FullName) 'FullName是完整路径+文件名
         If objWordDocName = strDocName Then
               WordDocIsOpen = True
               Exit For
         Else
              WordDocIsOpen = False
         End If
    Next
    Set objWordDoc = Nothing '清变量
    Set objWordApp = Nothing
End Function
 
③判断后，打开word文件（使用函数）
 
Sub OpenWord()
    If WordDocIsOpen("D:\Test\test.docx") Then
       MsgBox "该word文件已经被打开。"
    Else
        Set wrd = CreateObject("Word.Application")
        wrd.Visible = True
        wrd.Documents.Open fileName:="D:\Test\test.docx"
        Set wrd = Nothing
     End If
    
End Sub
 
④其他一些说明
 
1、判断word文件是否被打开以及打开了几个，要用GetObject，而不能用CreateObject。
 GetObject与CreateObject可以参看这个微软文档，写的很清楚。（无论多么简单的语言，都必须多看文档，少百度）
 
 
 
GetObject is used to attach to a running instance of an automation server.
 CreateObject is used to start a new instance of an Automation server.
 
 
2、如果不想用objWordDoc.FullName这种完整路径名的写法，可以用objWordDoc.Name，参数文件名可以这样截取：
 
    strPath = "D:\Test\test.docx"
    docName = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
 
参考引用的资料
 
判断指定的WORD文档是否被打开的函数代码
 微软文档：word与其他应用程序进行通讯
 微软文档：word（Documents对象）

通过遍历已经打开的工作簿
 *bookName需要加文件后缀名，如.xlsx
 
Public Function IsWorkbookOpened(bookName As String)
    Dim wb As Workbook
    IsWorkbookOpened = False
    
    For Each wb In Application.Workbooks
        If wb.Name = bookName Then
            IsWorkbookOpened = True
            Exit For
        End If
    Next

End Function

 
谢谢寻欢，原来核心就是GETOBJECT，特帖帮助内容，与大家分享：
 
GetObject 函数示例
 
该示例使用 GetObject 函数来获取对指定的 Microsoft Excel 的工作表 (MyXL) 的引用。它使用工作表的 Application 属性来显示或关闭 Microsoft Excel 等等。DetectExcel Sub 过程通过调用两个 API 函数，来查找 Microsoft Excel。如果 Microsoft Excel 正在运行，则将其放入运行对象表(Running Object Table)中。如果 Microsoft Excel 不在运行，则第一次调用 GetObject 将导致错误。在本例中，出现该错误则把 ExcelWasNotRunning 标志设为 True。第二次调用 GetObject 是指定要打开的一个文件。如果 Microsoft Excel 不在运行，则这个第二次的调用将启动该程序，并返回一个指定文件 (mytest.xls) 所对应的工作表的引用。该文件必须位于指定的位置；否则将产生 Visual Basic 错误及自动化错误。随后的示例代码将 Microsoft Excel 及包含指定工作表的窗口设为可见。最后，如果在此前没有 Microsoft Excel 的副本在运行，代码就使用 Application 对象的 Quit 方法来关闭 Microsoft Excel。如果该应用程序原来就在运行，则不要试图关闭它。引用本身在设为 Nothing 后被释放。
 
'声明必要的 API 例程：
 
Declare Function FindWindow Lib "user32" Alias _
 
"FindWindowA" (ByVal lpClassName as String, _
 
ByVal lpWindowName As Long) As Long
 
Declare Function SendMessage Lib "user32" Alias _
 
"SendMessageA" (ByVal hWnd as Long,ByVal wMsg as Long _
 
ByVal wParam as Long, _
 
ByVal lParam As Long) As Long
 
Sub GetExcel()
 
Dim MyXL As Object    '用于存放
 
'Microsoft Excel 引用的变量。
 
Dim ExcelWasNotRunning As Boolean    '用于最后释放的标记。
 
'测试 Microsoft Excel 的副本是否在运行。
 
On Error Resume Next    '延迟错误捕获。
 
'不带第一个参数调用 Getobject 函数将
 
'返回对该应用程序的实例的引用。
 
'如果该应用程序不在运行，则会产生错误。
 
Set MyXL = Getobject(, "Excel.Application")
 
If Err.Number <> 0 Then ExcelWasNotRunning = True
 
Err.Clear    '如果发生错误则要清除 Err 对象。
 
'检测 Microsoft Excel。如果 Microsoft Excel 在运行，
 
'则将其加入运行对象表。
 
DetectExcel
 
'将对象变量设为对要看的文件的引用。
 
Set MyXL = Getobject("c:\vb4\MYTEST.XLS")
 
'设置其 Application 属性，显示 Microsoft Excel。
 
'然后使用 MyXL 对象引用的 Windows 集合
 
'显示包含该文件的实际窗口。
 
MyXL.Application.Visible = True
 
MyXL.Parent.Windows(1).Visible = True
 
'在此处对文件
 
'进行操作。
 
' ...
 
'如果在启动时，Microsoft Excel 的这份副本不在运行中，
 
'则使用 Application 属性的 Quit 方法来关闭它。
 
'注意，当试图退出 Microsoft Excel 时，
 
'标题栏会闪烁，并显示一条消息
 
'询问是否保存所加载的文件。
 
If ExcelWasNotRunning = True Then
 
MyXL.Application.Quit
 
End IF
 
Set MyXL = Nothing    '释放对该应用程序
 
'和电子数据表的引用。
 
End Sub
 
Sub DetectExcel()
 
'该过程检测并登记正在运行的 Excel。
 
Const WM_USER = 1024
 
Dim hWnd As Long
 
'如果 Excel 在运行，则该 API 调用将返回其句柄。
 
hWnd = FindWindow("XLMAIN", 0)
 
If hWnd = 0 Then    '0 表示没有 Excel 在运行。
 
Exit Sub
 
Else
 
'Excel 在运行，因此可以使用 SendMessage API
 
'函数将其放入运行对象表。
 
SendMessage hWnd, WM_USER + 18, 0, 0
 
End If
 
End Sub

一、代码
 
'判断文件是否打开
Sub test()
    Dim i As Integer                        '定义循环变量
    For i = 1 To Workbooks.Count            '开始循环
        If Workbooks(i).Name = "模拟工资表.xlsx" Then    '判断工作簿是否打开
            MsgBox "文件已打开！"
            Exit Sub                        '如果找到文件，退出过程
        End If
    Next
    MsgBox "文件没有打开！"    
End Sub


'判断文件是否存在
Sub test()
    Dim fil As String                       '定义变量
    fil = ThisWorkbook.Path & "\另存工资表.xls"
    If Len(Dir(fil)) > 0 Then               '判断工作簿是否存在
        MsgBox "文件已存在！"
    Else
        MsgBox "文件不存在！"
    End If
End Sub

 
二、运行结果