タイトル : 既に開いてある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 '/////////////////////////////////////////////////////////////// |