(Excel VBA)閉じているブックからデータを取得する第2弾｜日々の覚書…日常のことも少しだけ

前回、閉じているエクセルブックから

データを取り出すことをしましたが

色々、問題があって

別の方法を見つけました。

仕事が忙しくて中々実装できなかった・・・

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はまだまだ分からないことばかり

色々エラーばかりで書き直すまでに時間がかかりました。