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

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