On Error Resume Next
    Set wrdApp = GetObject(, "Word.Application") '' if no word application then wrdapp = nothing
    If Not wrdApp Is Nothing Then   '' if word application found
        On Error GoTo 0
        For Each wrdDoc In wrdApp.Documents
            If wrdDoc.Name Like "*DR-*" Then
                iAns = MsgBox("Would you like to use the open document " & wrdDoc.Name & "?", vbYesNoCancel)
                If iAns = vbCancel Then Exit Sub    '' cancel exit the whole sub
                If iAns = vbYes Then Exit For       '' yes uses this file
            End If
        Next wrdDoc
        If iAns = vbNo Then wrdDoc = Nothing    '' if use has said no to all files then wrddoc needs to equal nothing
    End If
    If wrdDoc Is Nothing Then   '' either the user said no to all open files or there were no open files
        On Error GoTo 0

         '' get user to select file
        FileToOpen = GetInputFile
            
        If FileToOpen = "" Then
            MsgBox "Cancelled by user....Exiting...."
            Exit Sub
        Else
            Set wrdApp = CreateObject("Word.Application")
            Set wrdDoc = wrdApp.Documents.Open(FileToOpen)
        End If
    End If

Option Explicit

' Module Name: ModFindWindowLike
' (c) 2005 Wayne Phillips (http://www.everythingaccess.com)
' Written 02/06/2005
                    
Private Declare Function EnumWindows Lib "user32" _
   (ByVal lpEnumFunc As Long, _
    ByVal lParam As Long) As Long

Private Declare Function GetWindowText Lib "user32" _
    Alias "GetWindowTextA" _
   (ByVal hwnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long) As Long
   
Private Declare Function GetWindowModuleFileName Lib "user32" _
    Alias "GetWindowModuleFileNameA" (ByVal hwnd As Long, _
    ByVal Filename As String, ByVal cch As Long) As Long
    
'Custom structure for passing in the parameters in/out of the hook enumeration function
'Could use global variables instead, but this is nicer.
Private Type FindWindowParameters

    strTitle As String  'INPUT
    hwnd As Long        'OUTPUT

End Type

Public Function FnFindWindowLike(strWindowTitle As String) As Long

    'We'll pass a custom structure in as the parameter to store our result...
    Dim Parameters As FindWindowParameters
    Parameters.strTitle = strWindowTitle ' Input parameter

    Call EnumWindows(AddressOf EnumWindowProc, VarPtr(Parameters))
    
    FnFindWindowLike = Parameters.hwnd
    
End Function

Private Function EnumWindowProc(ByVal hwnd As Long, _
                               lParam As FindWindowParameters) As Long
   
   Dim strWindowTitle As String

   strWindowTitle = Space(260)
   Call GetWindowText(hwnd, strWindowTitle, 260)
   strWindowTitle = TrimNull(strWindowTitle) ' Remove extra null terminator
                                          
   If strWindowTitle Like lParam.strTitle Then
   
        lParam.hwnd = hwnd 'Store the result for later.
        EnumWindowProc = 0 'This will stop enumerating more windows
   
   End If
                           
   EnumWindowProc = 1

End Function

Private Function TrimNull(strNullTerminatedString As String)

    Dim lngPos As Long

    'Remove unnecessary null terminator
    lngPos = InStr(strNullTerminatedString, Chr$(0))
   
    If lngPos Then
        TrimNull = Left$(strNullTerminatedString, lngPos - 1)
    Else
        TrimNull = strNullTerminatedString
    End If
   
End Function

Sub test()

    Dim MyAppHWnd As Long
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim sFile As String
    Dim FileToOpen As String
    Dim iLen As Long
    
    MyAppHWnd = FnFindWindowLike("*DR-*")
    sFile = String$(1024, 0)
    iLen = GetWindowModuleFileName(MyAppHWnd, sFile, Len(sFile))
    If iLen > 0 Then
        sFile = Left$(sFile, iLen)
    End If
    
    Debug.Print sFile  '' currently give me EXCEL executable full path

end sub

<DllImport("Oleacc.dll")> _
Public Shared Function AccessibleObjectFromWindow( _
    ByVal hwnd As Integer, ByVal dwObjectID As UInteger, ByVal riid As Byte(), _
    ByRef ptr As Microsoft.Office.Interop.Excel.Window) As Integer
End Function

<DllImport("User32.dll")> _
Public Shared Function EnumChildWindows(ByVal hWndParent As Integer, _
    ByVal lpEnumFunc As EnumChildCallback, ByRef lParam As Integer) As Boolean
End Function

<DllImport("User32.dll")> _
Public Shared Function GetClassName(ByVal hWnd As Integer, _
    ByVal lpClassName As StringBuilder, ByVal nMaxCount As Integer) As Integer
End Function

Public Function EnumChildProc( _
    ByVal hwndChild As Integer, ByRef lParam As Integer) As Boolean

    Dim buf As New StringBuilder(128)
    GetClassName(hwndChild, buf, 128)
    If buf.ToString() = "EXCEL7" Then
        lParam = hwndChild
        Return False
    End If
    Return True
End Function

Public Delegate Function EnumChildCallback(ByVal hwnd As Integer, _
    ByRef lParam As Integer) As Boolean

Private cb As EnumChildCallback

Private xl As Excel.Application

Public Sub Connect()
    ' First, get Excel's main window handle.
    Dim hwnd As Integer = CInt(Process.GetCurrentProcess().MainWindowHandle)
   
    ' We need to enumerate the child windows to find one that
    ' supports accessibility. To do this, instantiate the
    ' delegate and wrap the callback method in it, then call
    ' EnumChildWindows, passing the delegate as the 2nd arg.
    If hwnd <> 0 Then
        Dim hwndChild As Integer = 0
        cb = New EnumChildCallback(EnumChildProc)
        EnumChildWindows(hwnd, cb, hwndChild)
       
        ' If we found an accessible child window, call
        ' AccessibleObjectFromWindow, passing the constant
        ' OBJID_NATIVEOM (defined in winuser.h) and
        ' IID_IDispatch - we want an IDispatch pointer
        ' into the native object model.
        If hwndChild <> 0 Then
            Const OBJID_NATIVEOM As UInteger = &Hfffffff0
            Dim IID_IDispatch As New Guid("{00020400-0000-0000-C000-000000000046}")
            Dim ptr As Excel.Window = Nothing
           
            Dim hr As Integer = _
                AccessibleObjectFromWindow( _
                    hwndChild, _
                    OBJID_NATIVEOM, _
                    IID_IDispatch.ToByteArray(), _
                    ptr)

            If hr >= 0 Then
                ' If we successfully got a native OM
                ' IDispatch pointer, we can QI this for
                ' an Excel Application (using the implicit
                ' cast operator supplied in the PIA).
                xl = ptr.Application
            End If
        End If
    End If
End Sub

Dim o1 As Object
Set o1 = VBA.CreateObject("Word.Application")
    
Dim o2 As Object
Set o2 = VBA.CreateObject("Word.Application")

Option Explicit

' Module Name: ModFindWindowLike
' (c) 2005 Wayne Phillips (http://www.everythingaccess.com)
' Written 02/06/2005
                    
Private Declare Function EnumWindows Lib "user32" _
   (ByVal lpEnumFunc As Long, _
    ByVal lParam As Long) As Long

Private Declare Function GetWindowText Lib "user32" _
    Alias "GetWindowTextA" _
   (ByVal hwnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long) As Long
   
Private Declare Function GetWindowModuleFileName Lib "user32" _
    Alias "GetWindowModuleFileNameA" (ByVal hwnd As Long, _
    ByVal Filename As String, ByVal cch As Long) As Long
    
'Custom structure for passing in the parameters in/out of the hook enumeration function
'Could use global variables instead, but this is nicer.
Private Type FindWindowParameters

    strTitle As String  'INPUT
    hwnd As Long        'OUTPUT

End Type

Public Function FnFindWindowLike(strWindowTitle As String) As Long

    'We'll pass a custom structure in as the parameter to store our result...
    Dim Parameters As FindWindowParameters
    Parameters.strTitle = strWindowTitle ' Input parameter

    Call EnumWindows(AddressOf EnumWindowProc, VarPtr(Parameters))
    
    FnFindWindowLike = Parameters.hwnd
    
End Function

Private Function EnumWindowProc(ByVal hwnd As Long, _
                               lParam As FindWindowParameters) As Long
   
   Dim strWindowTitle As String

   strWindowTitle = Space(260)
   Call GetWindowText(hwnd, strWindowTitle, 260)
   strWindowTitle = TrimNull(strWindowTitle) ' Remove extra null terminator
                                          
   If strWindowTitle Like lParam.strTitle Then
   
        lParam.hwnd = hwnd 'Store the result for later.
        EnumWindowProc = 0 'This will stop enumerating more windows
   
   End If
                           
   EnumWindowProc = 1

End Function

Private Function TrimNull(strNullTerminatedString As String)

    Dim lngPos As Long

    'Remove unnecessary null terminator
    lngPos = InStr(strNullTerminatedString, Chr$(0))
   
    If lngPos Then
        TrimNull = Left$(strNullTerminatedString, lngPos - 1)
    Else
        TrimNull = strNullTerminatedString
    End If
   
End Function

Sub test()

    Dim MyAppHWnd As Long
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim sFile As String
    Dim FileToOpen As String
    Dim iLen As Long
    
    MyAppHWnd = FnFindWindowLike("*DR-*")
    sFile = String$(1024, 0)
    iLen = GetWindowModuleFileName(MyAppHWnd, sFile, Len(sFile))
    If iLen > 0 Then
        sFile = Left$(sFile, iLen)
    End If
    
End Sub

SendMessage hWndWord, WM_USER + 18, 0, 0
Set objWord = Getobject(, "Word.Application")
'code here to look in objWord.Documents

SendMessage hWndWord, WM_ACTIVATEAPP, 0, 0
Set objWord = Getobject(, "Word.Application")
'code here to look in objWord.Documents