Найти все открытые Word-приложения из VBA EXCEL-Macro

sky_pablo спросил: 31 июля 2018 в 09:53 в: excel-vba

В макросе EXCEL я хочу скопировать выбранный диапазон в таблицу WORD-document. Я знаю, как это сделать, создавая новый WORD-документ (цель). Но я хочу проверить, есть ли уже открытые WORD-документы, из которых я могу выбрать цель.

Я нашел код для прокрутки всех открытых EXCEL-приложений из EXCEL-Macro. Я изменил код от Florent Breheret , как показано ниже.

Каковы недостающие имена классов, обозначенные символом"???" в коде, искать WORD-документы?

Спасибо заранее! Иммануил

Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
    ByVal hwnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As LongPrivate Declare PtrSafe Function FindWindowExA Lib "user32" ( _
    ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, _
    ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr'Test my code
Private Sub GetWordInstances_Test()
    Dim wd As Word.Application
    Dim i, cnt As Integer    cnt = 0
    For Each wd In GetWordInstances()
        cnt = cnt + 1
        Debug.Print wd.Application.Name, cnt        For i = 1 To wd.Documents.Count            Debug.Print wd.Documents(i).FullName, i
        Next i
    Next
End Sub'Getting open WORD instances from within EXCEL-VBA
Public Function GetWordInstances() As Collection
    Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
    guid(0) = &H20400
    guid(1) = &H0
    guid(2) = &HC0
    guid(3) = &H46000000    Set GetWordInstances = New Collection
    Do
        hwnd = FindWindowExA(0, hwnd, "OpusApp", vbNullString)
        If hwnd = 0 Then Exit Do        hwnd2 = FindWindowExA(hwnd, 0, "???", vbNullString)        hwnd3 = FindWindowExA(hwnd2, 0, "???", vbNullString)        'hand over found WORD application to collection
        If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
            GetWordInstances.Add acc.Application
        End If
    Loop
End Function

2 ответа

MasovyKnedlicek ответил: 31 июля 2018 в 10:52

Это работает для меня: 1. Добавьте ссылку в Excel: Инструменты-> Ссылки-> Библиотека объектов Microsoft Word XX.X2. Запустите этот код:

Sub openDocs ()

Dim openDoc     As Word.Document
Dim docCount    As LongdocCount = Documents.CountFor Each openDoc In Documents
    'do whatever, i.e.:
    ' debug.print openDoc.Name
Next openDocIf docCount = 0 Then
    MsgBox "There are no open documents."
Else
    MsgBox "There are " & docCount & " open documents."
End If

End Sub

sky_pablo ответил: 31 июля 2018 в 11:25
Привет Масовый, спасибо за ваш ответ. Я фактически попробовал подобный код выше. Некоторые, как, это не работает, следовательно, что означает: иногда это работает, иногда это не так. Именно так я и думал об использовании методов Windows API. Но я буду продолжать исследовать проблему.
Rich Michaels ответил: 01 августа 2018 в 10:56

Попробуйте что-то вроде этого ...

Sub CheckForWordApp()
Dim wApp As Object
On Error Resume Next
Set wApp = GetObject(, "Word.Application")
If Err.Number = 429 Then
    'Word application is not running so create it
    Set wApp = New Word.Application
    wApp.Visible = True
    'no documents will exist, so do something
Else
    'A Word application exists, make sure it's visible
    wApp.Visible = True
    If wApp.Document.Count > 0 Then
        'There are open documents so do something
    Else
        'No documents are open so do something else
    End If
End If
End Sub