こんにちは。
いつもお世話になっております。
申し訳ないのですが、どうぞ今回も宜しくお願い致します。
(WinXP_SP2 VB6_SP5)

今回は下記プログラムで、既に開いているエクセルファイルを
変数（xlsBook）にセットし、シートやブックにPassを設定した後に
終了させようと考えたのですが、
ある条件でうまくファイルPathを取得できません。
どうぞご教示の程宜しくお願い致します。

ある条件(手順)
１．このプログラムとは全く関係のないエクセルファイルを手動で
　　開いておきます。
２．目的のファイル（C:\TestExcel1.xls）を本プログラムを起動して、
　　開いた後に※迄すすめ本プログラムを終了します。
　　（ユーザー側のとんでもない操作など、エクセルを正常終了させなかった
　　　場合を想定）
３．再び本プログラムを起動。
　　当然、正常終了させていないので、C:\TestExcel1.xlsは二重起動と判断されます。
　　「 If StrComp(FindBook.FullName, TgtFilePath & TgtFileName, _
                                           vbTextCompare) = 0 Then 」において、
　　開いてる全てのエクセルファイルのPathを取得しようとしましたが、
　　項１で手動で開いたエクセルのPathは取得できるのですが、
　　項２の本プログラムで開いたエクセルのPathを拾ってもらえません。

　　どうすれば、正常終了しなかったエクセルファイルを変数（xlsBook）にセット
　　できるのでしょうか？
　　（ちなみに、項１を開いてない場合は、項２のファイルのPathを取得できます。）

　　また、xlsApp.Workbooks.Open(FindBook.FullName)のOpenが間違っているからか
　　上の「ちなみに〜」の方法で、既に開いてるエクセルのPathを取得、変数（xlsBook）
　　にセットし、終了処理(xlsBook.Close〜Set xlsApp = Nothing)してもタスクの
　　プロセスからExcel.exeが消えてくれないです。
　　この件についてもご教示の程宜しくお願い致します。

　　　　　記

'///////////////////////////////////////////////////////////////
Private Sub GetOpendExcelPath()
'参照設定：Microsoft Excel 11.0 Object Library
'ある条件下において起動中ExcelPathが取得出来ない検証
Dim xlsApp       As Excel.Application
Dim xlsBook      As Excel.Workbook
Dim xlsSheet     As Excel.Worksheet
Dim TgtFilePath As String
Dim TgtFileName As String
Dim RetFileName As String
Dim xlsWboot As Boolean
Dim FindBook As Excel.Workbook
'///////////////////////////////////////////////////////////////
'エラーを保留
On Error Resume Next

TgtFilePath = "C:\"
TgtFileName = "TestExcel1.xls"

    '目的のエクセルファイルの存在を確認
    RetFileName = Dir$(TgtFilePath & TgtFileName)
    If Len(RetFileName) = 0 Then
        MsgBox "そのファイルは存在しません。", vbCritical + vbOKOnly, "終了"
        End
    Else
        '二重起動確認
        Name TgtFilePath & TgtFileName As TgtFilePath & TgtFileName
        '起動していればエラーが発生
        If Err.Number Then
            xlsWboot = True
        End If
    End If

    '目的のエクセルファイルが起動中か否か？
    If xlsWboot = False Then
        '【起動していない】
        Set xlsApp = CreateObject("Excel.Application")
        xlsApp.Visible = True
        xlsApp.DisplayAlerts = False
        xlsApp.Caption = App.EXEName
    
        'エクセルBookを開く
        Set xlsBook = xlsApp.Workbooks.Open(TgtFilePath & TgtFileName)
        
        'その他正常処理プロセスへ
        
        'しかし正常処理プロセスを行ってるいる途中で、ユーザー側のとんでもない
　　　　'操作、または本プログラムが何らかの原因で固まってしまい、本プログラムを
　　　　'強制的に終了した事を想定(→つまり「End」)。
        '(固まった何らかの原因についてではなく、強制終了後に正常終了しなかった
　　　　'エクセルファイルをxlsBookにセットする方法をご教示お願いします。)

        End　'※

    Else
        '【起動中】
        Set xlsApp = GetObject(, "Excel.Application")
        xlsApp.Visible = True
        xlsApp.DisplayAlerts = False
    
        For Each FindBook In xlsApp.Workbooks
            '目的のエクセルファイルをさがす
            If StrComp(FindBook.FullName, TgtFilePath & TgtFileName, _
                                                        vbTextCompare) = 0 Then
                '目的のエクセルファイルならxlsBookにセット
                '(Openでいいのかな？)
                Set xlsBook = xlsApp.Workbooks.Open(FindBook.FullName)
                xlsBook.Close
                Set xlsBook = Nothing
                xlsApp.DisplayAlerts = True
                xlsApp.Quit
                Set xlsApp = Nothing
            End If
        Next
    End If
End Sub
'///////////////////////////////////////////////////////////////

        '【起動中】
        Set xlsBook = GetObject(TgtFilePath & TgtFileName)
        Set xlsApp = xlsBook.Application
でどうですか。

GODさん、どうもです。
サクッと目的のファイルをxlsBookにセットでき、やりたいことが一通り出来、
終了もできました。
またプロセスにも残らず大変満足し感謝しております。
とても助かりました、ありがとうございました。

以前作ったサンプルで、OLE Automation のオブジェクトを列挙しています。
http://www.koalanet.ne.jp/~akiya/vbtaste/vbp/EnumObj.lzh

で、このような方法を用いて Excel を列挙した上で、該当するものを
絞り込むことになるかもしれません。

> 以前作ったサンプルで、OLE Automation のオブジェクトを列挙しています。
★K.J.K.さん、どうもサンプルまで添付頂きありがとうございます。
添付を拝見させて頂きましたが、現在の当方スキルではすぐ様、理解し活用
するのが困難と思われます。
今回は申し訳ないのですがGODさん案の方を採用させて頂くことにしました。
丁重にお詫びしたいと思います。どうもすみませんでした。
また次回もこれに懲りず、ご教示の程どうぞ宜しくお願い致します。

こんにちは。
起動中のワークブックオブジェクトを取得できます。
リストボックスにワークブックオブジェクトのフルネームを表示します。

Form にコマンドボタンとリストボックスを各一個貼り付けて　
実行してみて下さい。

参照設定　Microsoft Excel XX.X Object Libray
          Accessibility  は OLEACC.DLL を参照する

******************* Standard Module ********************

Option Explicit
Private Declare Function EnumWindows Lib "user32.dll" _
                        (ByVal lpEnumFunc As Long, _
                         ByVal lParam As Long) As Long

Private Declare Function GetClassName Lib "user32.dll" _
                        Alias "GetClassNameA" _
                        (ByVal hWnd As Long, _
                         ByVal lpClassName As String, _
                         ByVal nMaxCount As Long) As Long

Private Declare Function EnumChildWindows Lib "user32.dll" _
                        (ByVal hWndParent As Long, _
                         ByVal lpEnumFunc As Long, _
                         ByVal lParam As Long) As Long

Private Declare Function GetWindowText Lib "user32.dll" _
                        Alias "GetWindowTextA" _
                        (ByVal hWnd As Long, _
                         ByVal lpString As String, _
                         ByVal nMaxCount As Long) As Long

Private Declare Function IIDFromString Lib "ole32" _
                        (lpsz As Any, lpiid As Any) As Long
        
Private Declare Function ObjectFromLresult Lib "oleacc" _
                        (ByVal lResult As Long, _
                         riid As Any, _
                         ByVal wParam As Long, _
                         ppvObject As Any) As Long

Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
                        (ByVal hWnd As Long, _
                         ByVal dwObjectID As Long, _
                         ByRef riid As Any, _
                         ByRef ppvObject As Any) As Long
Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

Private Enum NVADIRConstants
    NAVDIR_MIN
    NAVDIR_UP
    NAVDIR_DOWN
    NAVDIR_LEFT
    NAVDIR_RIGHT
    NAVDIR_NEXT
    NAVDIR_PREVIOUS
    NAVDIR_FIRSTCHILD
    NAVDIR_LASTCHILD
    NAVDIR_MAX
End Enum
Private Declare Function IsWindow Lib "user32" _
                        (ByVal hWnd As Long) As Long

Private Const CHILDID_SELF As Long = 0&
Private Const OBJID_NATIVEOM = &HFFFFFFF0
Private Const OBJID_CLIENT = &HFFFFFFFC

'固有の型を指定しても問題無さそうなのですが
'その場合は、EXCEL.EXEをOleView.Exe(Platform SDKに付属)で開いて
'IIDを調べて指定した方が無難かも知れません。 ↓
Private Const IID_IDispatch = "{00020400-0000-0000-C000-000000000046}"

Private Const WM_GETOBJECT = &H3D&

Type WbkDtl
    hWnd        As Long
    wkb         As Excel.Workbook
End Type
Public wD()     As WbkDtl
    
' コールバック関数
Private Function EnumWindowsProc(ByVal hWnd As Long, _
                                 ByVal lParam As Long) As Long
    Dim strClassBuff    As String * 128
    Dim strClass        As String
    Dim lngRtnCode      As Long
    Dim lngThreadId     As Long
    Dim lngProcesID     As Long

    ' クラス名取得
    lngRtnCode = GetClassName(hWnd, strClassBuff, Len(strClassBuff))
    strClass = Left(strClassBuff, InStr(strClassBuff, vbNullChar) - 1)
    If strClass = "XLMAIN" Then
        ' 子ウィンドウを列挙
        lngRtnCode = EnumChildWindows(hWnd, AddressOf EnumChildSubProc, lParam)
    End If
    ' 列挙を継続
EnumPass:
    EnumWindowsProc = True
End Function

' コールバック関数 - 子ウィンドウを列挙
Private Function EnumChildSubProc(ByVal hwndChild As Long, _
                                  ByVal lParam As Long) As Long
    Dim strClassBuff    As String * 128
    Dim strClass        As String
    Dim strTextBuff     As String * 516
    Dim strText         As String
    Dim lngRtnCode      As Long
    
    ' クラス名取得
    lngRtnCode = GetClassName(hwndChild, strClassBuff, Len(strClassBuff))
    strClass = Left(strClassBuff, InStr(strClassBuff, vbNullChar) - 1)
    If strClass = "EXCEL7" Then
        ' テキストをバッファに
        lngRtnCode = GetWindowText(hwndChild, strTextBuff, Len(strTextBuff))
        strText = Left(strTextBuff, InStr(strTextBuff, vbNullChar) - 1)
        If InStr(1, strText, ".xla") = 0 Then     '
            If Sgn(wD) = 0 Then
                ReDim wD(0)
                wD(0).hWnd = hwndChild
            Else
                ReDim Preserve wD(UBound(wD) + 1)
                wD(UBound(wD)).hWnd = hwndChild
            End If
        End If
    End If
    ' 列挙を継続
EnumChildPass:
    EnumChildSubProc = True
End Function

'***********   OLEACC.DLL を参照すること  *************

Private Sub GetExcelBookDObj(wDl As WbkDtl)
    Dim IID(0 To 3) As Long
    Dim bytID()     As Byte
    Dim lngResult   As Long
    Dim lngRtnCode  As Long
    Dim wbw         As Excel.Window
    Dim objAcc      As IAccessible
    Dim wb          As Workbook
    If IsWindow(wDl.hWnd) = 0 Then Exit Sub
    bytID = IID_IDispatch & vbNullChar
    IIDFromString bytID(0), IID(0)
    lngRtnCode = AccessibleObjectFromWindow(wDl.hWnd, OBJID_NATIVEOM, IID(0), objAcc)
    If Not objAcc Is Nothing Then Set wDl.wkb = objAcc.Parent
End Sub


Sub Main_Proc()
    Dim lngRtnCode  As Long
    Dim i           As Long
    Erase wD
'   ワークブックのウィンドウハンドルを取得 WorkBook->EXCEL7
    lngRtnCode = EnumWindows(AddressOf EnumWindowsProc, ByVal 0&)
    If Sgn(wD) <> 0 Then
        For i = 0 To UBound(wD)
            Call GetExcelBookDObj(wD(i))
        Next
    End If
End Sub


************ Form Module ********************
Option Explicit

Private Sub Command1_Click()
    Dim i   As Long
    Me.List1.Clear
    Call Main_Proc
    If Sgn(wD) <> 0 Then
        For i = 0 To UBound(wD)
            If Not wD(i).wkb Is Nothing Then
                Me.List1.AddItem wD(i).wkb.FullName
            End If
        Next
    End If
End Sub

> こんにちは。
★は〜い(＾＾)/　こんにちわ〜。
YKさん、サンプルコーディングまでして頂きありがとうございます。
しかし、現在の当方スキルではすぐ様、理解して、活用するのが
お恥ずかしいながら困難と思われます。徐々に勉強してスキルupするつもりです。
今回は申し訳ないのですがGODさん案の方を採用させて頂くことにしました。
お忙しい中、真剣にコーディング頂いたご苦労と優しいお気持ちに対して
丁重にお詫びしたいと思います。
どうもすみませんでした。
ありがとうございます。
次回もこれに懲りず、ご教示の程どうぞ宜しくお願い致します。