Find all open Word Applications from within a VBA EXCEL-Macro

Question

In an EXCEL-macro I want to copy a selected range to a WORD-document table. I know how to do this, creating a new WORD-document (target). But I want to check if there are already open WORD-documents from which I can select a target.

I found code for looping through all open EXCEL-Applications from within a EXCEL-Macro. I modified the code from Florent Breheret as given below.

What are the missing class names, indicated by "???" in the code, to look for WORD-documents?

Thank you in advance! Immanuel

Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
    ByVal hwnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long

Private 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

*Welcome to [so]!* This is a site where programmers share a *specific* problem with their code. Only the section of code that is the problem should be included. Please see **how to create a [mcve]**, as well as "[ask]". (Also, [here is a checklist](//codeblog.jonskeet.uk/stack-overflow-question-checklist/) from the site's top user.) — ashleedawg, Aug 24 '18 at 12:01
Also, it seems a little counter-intuitive, but here is explanation of [Why is “Can someone help me?” not an actual question?](https://meta.stackoverflow.com/a/284237/8112776). — ashleedawg, Aug 24 '18 at 12:03
Thank you for your input. I will consider it for future questions and modified the post above (made it shorter, only one question). And "Can someone help me.." yeah, I see your point :-) — sky_pablo, Aug 24 '18 at 13:02

score 1 · Answer 1 · answered Aug 24 '18 at 12:32

1

This works for me: 1. Add the reference in Excel: Tools->References->Microsoft Word XX.X Object Library 2. Run this code:

Sub openDocs()

Dim openDoc     As Word.Document
Dim docCount    As Long

docCount = Documents.Count

For Each openDoc In Documents
    'do whatever, i.e.:
    ' debug.print openDoc.Name
Next openDoc

If docCount = 0 Then
    MsgBox "There are no open documents."
Else
    MsgBox "There are " & docCount & " open documents."
End If

End Sub

answered Aug 24 '18 at 12:32

MasovyKnedlicek

88
7

Hi Masovy, thanks for your answer. I actually tried a similar code above. Some how, it does not work consequently, meaning: Sometimes it works, some times it does not. That is way I thought of using Windows API methods. But I will keep researching the problem. – sky_pablo Aug 24 '18 at 13:05

score 1 · Answer 2 · answered Aug 25 '18 at 12:36

Try something like this ...

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

H Rich, thanks for the answer. I am a year late :) but thanks! I solved the problem with the Marcelo's answer (below). But thanks for your support! Immanuel — sky_pablo, Sep 11 '19 at 12:50

Marcelo Scofano Diniz · Accepted Answer · 2019-01-28T14:46:20.947

1

See this answer that explains the process to solve your question.

Resuming:

OpusApp ==> _WwF ==> _WwB ==> _WwG.

You must add another layer:

    hwnd = FindWindowExA(0, hwnd, "OpusApp", vbNullString)
    If hwnd = 0 Then Exit Do

    hwnd2 = FindWindowExA(hwnd, 0, "_WwF", vbNullString)

    hwnd3 = FindWindowExA(hwnd2, 0, "_WwB", vbNullString)

    hwnd4 = FindWindowExA(hwnd3, 0, "_WwG", vbNullString)
    'hand over found WORD application to collection
    If AccessibleObjectFromWindow(hwnd4, &HFFFFFFF0, guid(0), acc) = 0 Then
        GetWordInstances.Add acc.Application
    End If

edited Jan 28 '19 at 14:46

answered Jan 27 '19 at 22:29

Marcelo Scofano Diniz

590
1
7
24

1

Thank you for your support! That solves it for me. Good to know I was close :) Cheers, Immanuel – sky_pablo Sep 11 '19 at 12:50
@sky_pablo, if it solves to you, please mark as correct answer (the green check-mark); in this way all people looking for solution will know that there is actually an answer... and if you don't mind, you may too up-vote my answer ;) – Marcelo Scofano Diniz Nov 28 '20 at 12:29

Find all open Word Applications from within a VBA EXCEL-Macro

3 Answers3