Excel VBA - 獲取在多個 Word 實例之一中打開的 Word 文檔

Question

我搜索了高低，以下代碼是我最接近目標的代碼。
這就是我正在做的事情：
我在 email 文檔中給我的學生寫了一些代碼（好吧，老實說，主要是復制點點滴滴並粘貼到可能是混亂的代碼中）。 如果文檔已打開，我會收到錯誤消息，這使我可以手動保存和關閉文檔（感謝調試），然后繼續。 我想自動執行此操作，但 Word 通過在單獨的實例中打開每個文檔似乎使事情變得有點困難。 我可以獲得一個實例及其文檔，但如果它不是我需要的，我無法保存和關閉它。 我找到了如何獲取其他實例，但我還沒有找到如何檢查每個實例以查看它打開的文檔是否是我想要的文檔。

我在（ 檢查 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 應用程序實例的數量。 下面的 function 從 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

function 設計用於早期綁定，這意味着您需要添加對 Microsoft Word Object 庫的引用。 在開發過程中，最好以這種方式工作。 在您的代碼完全開發和測試后，您可以更改為后期綁定。

請注意WdApp.Visible = True行。 我添加它是為了證明可以修改 object。 If Err括號內的修改僅適用於新創建的實例。 無論WdApp是如何創建的，它都將適用於我放置的位置。

下一個過程演示如何在您的項目中使用 function。 （您可以按原樣運行它。）

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在這里聲明並傳遞給 function。 function 為其分配一個 object 並返回該 object 以前是否存在的信息。 如果實例已創建，我將使用此信息關閉實例，如果用戶在宏運行之前將其打開，則將其保持打開狀態。

這兩個消息框僅用於演示。 您可以使用它們占據的邏輯空間來做其他事情。 而且，是的，我更願意將我正在查看的實例中的每個文檔分配給 object 變量。 使用早期綁定時，您將獲得 Intellisense 的額外好處。

編輯

您的過程枚舉了進程。 我無法找到一種方法來確定將流程轉換為應用程序的實例。 換句話說，您可以枚舉進程並找出正在運行的 Word 實例的數量，但我無法將這些實例中的任何一個轉換為應用程序的特定功能實例，以便訪問其中打開的文檔。 因此，我決定枚舉 windows 並從那里返回文檔。 下面的function專門省略了不可見打開的文檔。

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 函數很重要——它們上面沒有代碼。 您的問題沒有擴展到您想要對文件執行的操作，但您希望將它們列出來，這就完成了。