tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
[ツリー表示へ]  [ワード検索]  [Home]

タイトル 既に開いてあるExcelのPathを取得
投稿日: 2009/07/07(Tue) 07:58
投稿者ケイ
こんにちは。
いつもお世話になっております。
申し訳ないのですが、どうぞ今回も宜しくお願い致します。
(WinXP_SP2 VB6_SP5)

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

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

  どうすれば、正常終了しなかったエクセルファイルを変数(xlsBook)にセット
  できるのでしょうか?
  (ちなみに、項1を開いてない場合は、項2のファイルの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
'///////////////////////////////////////////////////////////////

- 関連一覧ツリー をクリックするとツリー全体を一括表示します)

古いスレッドにレスはつけられません。