スポンサードリンク

前回、閉じているエクセルブックから
データを取り出すことをしましたが
色々、問題があって
別の方法を見つけました。
仕事が忙しくて中々実装できなかった・・・
スポンサードリンク
VBAでファイルを開けばよい

使う人がごちゃごちゃして
煩わしくないように
VBAで開いて、非表示状態にしておけば
そんなに気にならないかな?と思い
下記のようにしてみました。
Sub Sample1() Dim OpenFilePath As String '調べたいファイルのフルパス Dim OpenFileName As String '調べたいファイルのファイル名 Dim OpenFile As String '調べたいファイルのフルパス+ファイル名 Dim Target As Worksheet, flag As Boolean '調べたいファイルのシート名確認用 Dim SheetName As String '調べたいファイルのシート名 Dim InspectBook As Workbook '調べたいファイルのファイル操作用 'ファイル名を作成 OpenFilePath = Sheets("Sheet1").Cells(1, 2).Value OpenFileName = Sheets("Sheet1").Cells(2, 2).Value & ".xlsx" OpenFile = OpenFilePath & "\" & OpenFileName 'ファイルが存在するか If Not Dir(OpenFile) <> "" Then MsgBox ("調べたいファイルがありません。" & vbCrLf & "ファイルの場所・名前を確認して修正して下さい。"), vbExclamation OpenFilePath = "" OpenFileName = "" OpenFile = "" Exit Sub Else 'シート名を取得 SheetName = Sheets("Sheet1").Cells(3, 2).Value 'ファイルを読み取り専用・非表示で開く Set InspectBook = Workbooks.Open(OpenFile, ReadOnly:=True) ActiveWindow.Visible = False '非表示 '調べたいファイルでのシート名が正しいか確認 For Each Target In InspectBook.Worksheets If Target.Name = SheetName Then flag = True Next Target If flag = False Then MsgBox ("シート名【" & SheetName & "】がありません。" & vbCrLf & "シート名確認して修正して下さい。"), vbExclamation OpenFileName = "" Exit Sub End If '非表示の状態でファイル操作 End If End Sub
後々のことも考えて
調べたいファイルはシートのセルに書き込むことで
ファイル名が変わっても対応できるようにしました。
'ファイル名を作成 OpenFilePath = Sheets("Sheet1").Cells(1, 2).Value OpenFileName = Sheets("Sheet1").Cells(2, 2).Value & ".xlsx" OpenFile = OpenFilePath & "\" & OpenFileName
シート名【Sheet1】のB1に記述したファイルの場所にある、
B2に記述したファイル名のファイルを指定します。
'ファイルが存在するか If Not Dir(OpenFile) <> "" Then MsgBox ("調べたいファイルがありません。" & vbCrLf & "ファイルの場所・名前を確認して修正して下さい。"), vbExclamation OpenFilePath = "" OpenFileName = "" OpenFile = "" Exit Sub
ここで指定したファイルが存在するか、しないかを判定して
なければVBAを終了します。
Else 'シート名を取得 SheetName = Sheets("Sheet1").Cells(3, 2).Value 'ファイルを読み取り専用・非表示で開く Set InspectBook = Workbooks.Open(OpenFile, ReadOnly:=True) ActiveWindow.Visible = False '非表示 '調べたいファイルでのシート名が正しいか確認 For Each Target In InspectBook.Worksheets If Target.Name = SheetName Then flag = True Next Target If flag = False Then MsgBox ("シート名【" & SheetName & "】がありません。" & vbCrLf & "シート名確認して修正して下さい。"), vbExclamation OpenFileName = "" Exit Sub End If
調べたいファイルが存在すれば
ファイルの場所などを指定したシートに
使用したいシート名をC2に記述してあるので
シート名を調べて間違っていればメッセージボックスでエラーを吐き出して
VBAを終了させます。
あっていれば処理を行います。
こんな感じで実装しました。
このあと、VBAで関数を使って
内部作業をするのですが
こちらはまた次回書きたいと思います。
しかし、VBAはまだまだ分からないことばかり
色々エラーばかりで書き直すまでに時間がかかりました。
スポンサードリンク