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

Question

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

我在()中使用了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

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

Answer 1

您可以考虑控制创建的 Word 应用程序实例的数量。下面的函数从 Excel 调用，将 return 一个现有的 Word 实例，或者仅当 none 存在时才创建一个新实例。

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并传递给函数。该函数将一个对象分配给它，并且 return 提供该对象以前是否存在的信息。如果创建了实例，我将使用此信息关闭实例；如果用户在宏运行.

之前打开实例，则将其保持打开状态

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

编辑

您的程序枚举了进程。我无法找到一种方法来确定将流程转换为应用程序的实例。换句话说，您可以枚举进程并找出有多少 Word 实例正在运行ning，但我无法将这些实例中的任何一个转换为应用程序的特定功能实例以访问在中打开的文档它。因此我决定改为枚举 windows 并从那里回到文档。下面的函数特意省略了隐形打开的文件。

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 函数很重要 - 上面没有代码。您的问题没有扩展到您想对这些文件做什么，但您希望将它们列出来，这已经完成了。

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

Excel VBA - Get Word doc opened in one of many Word instances

excel

vba

ms-word

multiple-instances

编辑