Excel VBA - 在多个 Word 实例之一中打开 Word 文档

如何解决Excel VBA - 在多个 Word 实例之一中打开 Word 文档

我搜索了高低，以下代码是我最接近我的目标的代码。
这就是我的工作：
我写了一些代码（好吧，老实说，主要是复制零碎的部分并粘贴到可能有效的混乱代码中）通过电子邮件将文档发送给我的学生。如果文档是打开的，我会得到并出错，这允许我手动保存和关闭文档（感谢调试），然后继续。我想自动执行此操作，但 Word 通过在单独的实例中打开每个文档似乎使事情变得有点困难。我可以获得一个实例及其文档，但如果它不是我需要的，我将无法保存和关闭它。我找到了如何获取其他实例，但我还没有找到如何检查每个实例以查看它打开的文档是否是我想要的文档。

我在 (Check if Word instance is running) 中使用了 ZeroKelvin 的 UDF，我对其进行了一些修改...

Dim WMG As Object,Proc As Object
Set WMG = Getobject("winmgmts:")
For Each Proc In WMG.InstancesOf("win32_process")
  If UCase(Trim(Proc.Name)) = "WINWORD.EXE" Then

              *'Beginning of my code...*
    *'This is what I need and have no idea how to go about*
    Dim WdApp as Word.Application,WdDoc as Object
            *' is it better to have WdDoc as Document?*
    set WdDoc =       ' ### I do not kNow what goes here ...
    If WdDoc.Name = Doc2Send Or WdDoc.Name = Doc2SendFullName Then
            *' ### ... or how to properly save and close*
      WdApp.Documents(Doc2Send).Close (wdPromptToSaveChanges)
      Exit For
    End If
              *'... end of my code*

    Exit For
  End If
Next 'Proc
Set WMG = nothing

感谢您的时间和努力。
干杯

解决方法

您可能想考虑控制创建的 Word 应用程序实例的数量。下面的函数从 Excel 调用，将返回现有的 Word 实例或仅在不存在的情况下创建一个新的实例。

Private Function GetWord(ByRef WdApp As Word.Application) As Boolean
    ' 256
    ' return True if a new instance of Word was created
    
    Const AppName As String = "Word.Application"

    On Error Resume Next
    Set WdApp = GetObject(,AppName)
    If Err Then
        Set WdApp = CreateObject(AppName,"")
    End If
    WdApp.Visible = True
    GetWord = CBool(Err)
    Err.Clear
End Function

该函数是为早期绑定而设计的，这意味着您需要添加对 Microsoft Word 对象库的引用。在开发过程中，最好以这种方式工作。在您的代码完全开发和测试之后，您可以更改为后期绑定。

请注意行 WdApp.Visible = True。我添加它是为了证明可以修改对象。 If Err 括号内所做的修改仅适用于新创建的实例。无论 WdApp 是如何创建的，它都会适用于我放置的位置。

下一个过程演示如何在您的项目中使用该函数。 （您可以按原样运行它。）

Sub Test_GetWord()
    ' 256
    
    Dim WdApp       As Word.Application
    Dim NewWord     As Boolean
    Dim MyDoc       As Word.Document
    
    NewWord = GetWord(WdApp)
    If NewWord Then
        Set MyDoc = WdApp.Documents.Add
        MsgBox "A new instance of Word was created and" & vbCr & _
               "a document added named " & MyDoc.Name
    Else
        MsgBox "Word is running and has " & WdApp.Documents.Count & " document open."
    End If
End Sub

如您所见，变量 WdApp 在此处声明并传递给函数。该函数为其分配一个对象并返回该对象之前是否存在的信息。如果实例已创建，我将使用此信息关闭该实例，如果用户在运行宏之前将其打开，则将其保持打开状态。

这两个消息框仅用于演示。您可以使用它们占用的逻辑空间来做其他事情。而且，是的，我更愿意将我正在查看的实例中的每个文档分配给一个对象变量。在使用早期绑定时，您将获得 Intellisense 的额外好处。

编辑

您的过程会枚举进程。我无法找到确定将流程转换为应用程序实例的方法。换句话说，您可以枚举进程并找出正在运行的 Word 实例的数量，但我无法将这些实例中的任何一个转换为应用程序的特定功能实例，以便访问其中打开的文档。因此，我决定枚举窗口，然后从那里返回到文档。下面的函数专门省略了隐形打开的文档。

Option Explicit

Private Declare PtrSafe Function apiGetClassName Lib "user32" Alias _
                "GetClassNameA" (ByVal Hwnd As Long,_
                ByVal lpClassname As String,_
                ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function apiGetDesktopWindow Lib "user32" Alias _
                "GetDesktopWindow" () As Long
Private Declare PtrSafe Function apiGetWindow Lib "user32" Alias _
                "GetWindow" (ByVal Hwnd As Long,_
                ByVal wCmd As Long) As Long
Private Declare PtrSafe Function apiGetWindowLong Lib "user32" Alias _
                "GetWindowLongA" (ByVal Hwnd As Long,ByVal _
                nIndex As Long) As Long
Private Declare PtrSafe Function apiGetWindowText Lib "user32" Alias _
                "GetWindowTextA" (ByVal Hwnd As Long,ByVal _
                lpString As String,ByVal aint As Long) As Long
Private Const mcGWCHILD = 5
Private Const mcGWHWNDNEXT = 2
Private Const mcGWLSTYLE = (-16)
Private Const mcWSVISIBLE = &H10000000
Private Const mconMAXLEN = 255
 
Sub ListName()
' 256
    ' adapted from
    ' https://www.extendoffice.com/documents/excel/4789-excel-vba-list-all-open-applications.html
    
    Dim xStr            As String
    Dim xStrLen         As Long
    Dim xHandle         As Long
    Dim xHandleStr      As String
    Dim xHandleLen      As Long
    Dim xHandleStyle    As Long
    Dim WdDoc           As Word.Document
    Dim Sp()            As String
    
    On Error Resume Next
    xHandle = apiGetWindow(apiGetDesktopWindow(),mcGWCHILD)
    Do While xHandle <> 0
        xStr = String$(mconMAXLEN - 1,0)
        xStrLen = apiGetWindowText(xHandle,xStr,mconMAXLEN)
        If xStrLen > 0 Then
            xStr = Left$(xStr,xStrLen)
            xHandleStyle = apiGetWindowLong(xHandle,mcGWLSTYLE)
            If xHandleStyle And mcWSVISIBLE Then
                Sp = Split(xStr,"-")
                If Trim(Sp(UBound(Sp))) = "Word" Then
                    ReDim Preserve Sp(UBound(Sp) - 1)
                    xStr = Trim(Join(Sp,"-"))
                    Set WdDoc = Word.Application.Documents(xStr)
                    ' this applies if the document was not saved:-
                    If WdDoc.Name <> xStr Then Set WdDoc = GetObject(xStr)
                    Debug.Print xStr,Debug.Print WdDoc.Name
                End If
            End If
        End If
        xHandle = apiGetWindow(xHandle,mcGWHWNDNEXT)
    Loop
End Sub

请注意，将 API 函数放在模块顶部很重要 - 上面没有代码。您的问题不涉及您想对文件做什么，但您希望将它们列出来，这已经完成。