Как перебрать несколько экземпляров Word (с AccessibleObjectFromWindow) - PullRequest
0 голосов
/ 26 января 2019

Мне нужно перебрать все экземпляры Word, независимо от того, открыты ли они пользователями, с помощью автоматизации, zumbis и т. Д.

Я опишу все шаги до сих пор: Я видел и реализовывал решения, которые я получил здесь ;

       Do
            For Each objWordDocument In objWordApplication.Documents
               OpenDocs(iContadorDocs - 1) = objWordDocument.Name
               OpenDocs(iContadorDocs) = objWordDocument.path
               iContadorDocs = iContadorDocs + 2
               ReDim Preserve OpenDocs(iContadorDocs)
            Next objWordDocument
            iWordInstances = iWordInstances + 1
            objWordApplication.Quit False
            Set objWordApplication = Nothing
            Set objWordApplication = GetObject(, "Word.Application")
       Loop While Not objWordApplication Is Nothing

это работает, но:

  1. для итерации по всем экземплярам слов, мы должны GetObject и закрыть его, зацикливаясь до тех пор, пока не останется больше открытых экземпляров, и после этого снова открыть все, что мне нужно

    • это занимает много времени и R / W циклов и доступ к диску

    • и, конечно, это должно быть выполнено вне Word, потому что он может сначала закрыть экземпляр, выполняющий код, или в середине цикла ...

Итак, после некоторого поиска, я увидел несколько примеров прямого доступа к процессу: здесь и здесь для VB.

Мне удалось получить PID для всех экземпляров Winword.exe, в основном немного адаптировав код на VBForums :

Отображение только измененного фрагмента кода:

   Do
        If LCase(VBA.Left$(uProcess.szExeFile, InStr(1, uProcess.szExeFile, Chr(0)) - 1)) = LCase(ProcessName) Then
            ProcessId = uProcess.th32ProcessID
            Debug.Print "Process name: " & ProcessName & "; Process ID: " & ProcessId
        End If
   Loop While ProcessNext(hSnapShot, uProcess)

Для выполнения приведенного выше кода нам нужна структура PROCESSENTRY32, которая включает в себя как поля имени процесса (szExeFile), так и поля идентификатора процесса (th32ProcessID); это код @ VBnet / Randy Birch .

Итак, теперь у меня есть PIDs экземпляров слов; что дальше?

После этого я попытался выяснить, как можно передать эти экземпляры PID в функцию GetObject.

В это время я натолкнулся на этот поток Python , который открыл мне глаза на AccessibleObjectFromWindow , который создает объект из дескриптора окна.

Я копал во многих местах, самые полезные из них здесь , здесь и здесь и могли бы получить этот кусок кода:

Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" _
        (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
         ByVal lpsz2 As String) As Long
Private Declare Function IIDFromString Lib "ole32" _
        (ByVal lpsz As Long, ByRef lpiid As GUID) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
        (ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As GUID, _
         ByRef ppvObject As Object) As Long

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
Private Const S_OK As Long = &H0
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0

Sub testWord()
Dim i As Long
Dim hWinWord As Long
Dim wordApp As Object
Dim doc As Object
    'Below line is finding all my Word instances
    hWinWord = FindWindowEx(0&, 0&, "OpusApp", vbNullString)
    While hWinWord > 0
        i = i + 1
        '########Successful output
        Debug.Print "Instance_" & i; hWinWord
        '########Instance_1 2034768 
        '########Instance_2 3086118 
        '########Instance_3 595594 
        '########Instance_4 465560 
        '########Below is the problem
        If GetWordapp(hWinWord, wordApp) Then
            For Each doc In wordApp.documents
                Debug.Print , doc.Name
            Next
        End If
        hWinWord = FindWindowEx(0, hWinWord, "OpusApp", vbNullString)
    Wend
End Sub

Function GetWordapp(hWinWord As Long, wordApp As Object) As Boolean
Dim hWinDesk As Long, hWin7 As Long
Dim obj As Object
Dim iid As GUID

    Call IIDFromString(StrPtr(IID_IDispatch), iid)
    hWinDesk = FindWindowEx(hWinWord, 0&, "_WwF", vbNullString)
   '########Return 0 for majority of classes; only for _WwF it returns other than 0
    hWin7 = FindWindowEx(hWinDesk, 0&, "_WwB", vbNullString)
   '########Return 0 for majority of classes; only for _WwB it returns other than 0
    If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iid, obj) = S_OK Then
   '########Return -2147467259 and does not get object...
        Set wordApp = obj.Application
        GetWordapp = True
    End If
End Function

Ошибки комментируются (########) выше в коде; но возобновляя, я идентифицирую все экземпляры, но не могу получить объект. Для Excel строки:

hWinDesk = FindWindowEx(hWinXL, 0&, "XLDESK", vbNullString)
hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)

работает, потому что вместо нуля я получил hWinDesk = 1511272 и 332558, а после я получил объект Excel.

Класс Word для EXCEL7, соответствующий классу Windows - _WwG (но он дает 0 выше), имя класса Word, соответствующее XLMAIN, - OpusApp. Что такое XLDESK, соответствующий Word?

Итак, мне нужна помощь, чтобы обнаружить это; или вы знаете, как захватить COM-объект в VBA, зная, что это PID? Сама MS предложила мне заглянуть в Office 200 docs ; Я сделаю это, но если кто-то сделал это раньше ...

На самом деле, теперь меня интересуют оба подхода, но, конечно, этот последний реализован на 99%, поэтому я предпочел.

TIA

P.S. Конечно, при реализации все объекты будут закрыты / ничего, обработка ошибок и т. Д ...

РЕДАКТИРОВАТЬ 1: Вот вывод Spy ++, согласно совету @Comintern: Spy++ Output

Интересно, что я могу найти в выходных данных Excel только две строки: XLMAIN и XLDESK, но не могу найти вообще EXCEL7, и объект Excel успешно захвачен. Для Word я протестировал все строки (_WwC, _WwO,), но только

?FindWindowEx(hWinWord, 0&, "_WwF", vbNullString)
 1185896 
?FindWindowEx(hWinDesk, 0&, "_WwB", vbNullString)
 5707422 

получил ручку в таком порядке; но безрезультатно, потому что

 ?AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iid, obj)
-2147467259 

Есть идеи? направления? * * 1092

Ответы [ 2 ]

0 голосов
/ 28 января 2019

Я могу подтвердить ваш код.

Вот диаграмма на дескрипторах окон для Word, на которой дескрипторы отвечают на запросы интерфейса Accessibility (выделены желтым цветом с указанием TypeName в комментарии) и какую из них можно преобразовать в Word.Application (выделено светло-зеленым цветом)

Оригинальная статья здесь (Отказ от ответственности, это мой блог) Word Windows Handle

Ваш вопрос заставил меня найти общий случай, и поэтому в этом сообщении в блоге можно найти код, который также используется для экземпляра PowerPoint (и, конечно, для Excel). Спасибо за вызов.

0 голосов
/ 28 января 2019

После более тесного общения со Spy ++, как предложил @Comintern, я проследил это:

enter image description here

Это фактический порядок окон;все окна ниже OpusApp являются его дочерними элементами

Но чтобы понять, почему он работает сейчас, мы должны щелкнуть правой кнопкой мыши каждый _Ww [A_Z] ниже:

Для _WwF:

enter image description here

Для своих детей _WwB:

enter image description here

И, наконец, к цели !!!!!_WwG:

enter image description here

При таком подходе очевидно, что мы должны добавить еще один слой к коду:

  Function GetWordapp(hWinWord As Long, wordApp As Object) As Boolean
        Dim hWinDesk As Long, hWin7 As Long, hFinalWindow As Long
        Dim obj As Object
        Dim iid As GUID

        Call IIDFromString(StrPtr(IID_IDispatch), iid)
        hWinDesk = FindWindowEx(hWinWord, 0&, "_WwF", vbNullString)
        hWin7 = FindWindowEx(hWinDesk, 0&, "_WwB", vbNullString)
        hFinalWindow = FindWindowEx(hWin7, 0&, "_WwG", vbNullString)
        If AccessibleObjectFromWindow(hFinalWindow, OBJID_NATIVEOM, iid, obj) = S_OK Then
            Set wordApp = obj.Application
            GetWordapp = True
        End If
    End Function

ЧтоЯ не понимаю, но сейчас не против, поэтому дублирую результаты для двух разных экземпляров: Результаты Debug.print:

   Instance_1 1972934 
                  x - fatores reumaticos.docx
                  FormGerenciadorCentralPacientes.docm
    Instance_2 11010524 
                  x - fatores reumaticos.docx
                  FormGerenciadorCentralPacientes.docm
    Instance_3 4857668 

Но для решения этой проблемы я адаптирую чудорешение по @ PGS62;возобновление:

Private Function GetWordInstances() As Collection
    Dim AlreadyThere As Boolean
    Dim wd As Application
    Set GetWordInstances = New Collection
    ...code...
    For Each wd In GetWordInstances 
                If wd Is WordApp.Application Then
                    AlreadyThere = True
                    Exit For
                End If
            Next
            If Not AlreadyThere Then
                GetWordInstances.Add WordApp.Application
            End If
      ...code...
End Function

И, вуаля, итерация для всех экземпляров Word для масс без необходимости закрывать и открывать снова !!!

Спасибо, сообщество, за все идеи в других темах, и@ Коминтерн за важный совет.

...