EXCEL VBA でフォルダ内のブックを開きデータを読み込む

　Power Query が使えないと不便である．先日 EXCEL 2010 の素の環境でフォルダ内のブックをすべて開き，データを読み込む必要があったのだが，Power Query が使えなかったため，VBA でブックを開いて読み込まなければならなかった．備忘録としての記事である．

　この記事はPower Query でフォルダから複数ファイルを一括インポートすると対応している．やっていることは同じだが，.xls 形式だとクエリの検証に時間がかかるため，VBA で読み込んだほうが動作は早いかもしれない．

　フォルダー内のファイル一覧を取得するには FileSystemObject を使う場合と Dir() 関数を使う方法とがある．ここでは FileSystemObject を使うことにする．

　データは Range オブジェクトに格納されているため，Range オブジェクトを取得するのが当面の目標となる．

Microsoft Scripting Runtime を参照設定する

　VBE のツールメニューから参照設定を選ぶ．

　参照設定ダイアログが開くので，スクロールして Microsoft Scripting Runtime を探し，チェックを入れる．

　この Microsoft Scripting Runtime は EXCEL だけではなく Word や PowerPoint, Access といった Office の中核をなすアプリからも参照することができるライブラリである．

オブジェクトの階層と構文のネストを対応させる

　最近の VBE でのコードの記述スタイルは，オブジェクトの階層と構文のネストを対応させていることが多い．ここではフォルダー，ファイル，ブック，ワークシート，セルの順である．ファイルとブックは抽象的には同じ階層であるが，構文上は別のオブジェクトになる．

FileSystemObject のインスタンスを生成する

　標準モジュールに変数を宣言する．New キーワードを使ってインスタンスを生成する．

　FileSystemObject は Windows のファイルシステムに関するオブジェクトであり，ドライブやフォルダー，ファイルのメタデータを取得するものである．詳細は後述する．

Sub sample()

Dim myFSO   As Scripting.FileSystemObject
Set myFSO = New Scripting.FileSystemObject

End Sub

Files コレクションから File オブジェクトを取得する

　FileSystemObject オブジェクトの GetFolder メソッドにファイルパスを引数として渡し，Files コレクションのインスタンスを生成する．Files コレクションをループして File オブジェクトを取得する．

　ここでの目的はファイルパスを文字列として取得することである．

Sub sample()

Dim myFSO   As Scripting.FileSystemObject
Set myFSO = New Scripting.FileSystemObject

Dim myFiles As Scripting.Files
Dim myFile  As Scripting.File
 
Set myFiles = myFSO.GetFolder(ThisWorkbook.Path).Files

For Each myFile In myFiles
Next myFile

End Sub

File オブジェクトの Name プロパティにフィルターをかける

　筆者の環境では暗黙の前提としてブック名の前半が共通の文字列であるため， Left 関数をフィルターとして使っている．Power Query なら列に対して「…で始まる」のテキストフィルターを適用しているところである．

Sub sample()

Dim myFSO   As Scripting.FileSystemObject
Set myFSO = New Scripting.FileSystemObject

Dim myFiles As Scripting.Files
Dim myFile  As Scripting.File

Set myFiles = myFSO.GetFolder(ThisWorkbook.Path).Files

For Each myFile In myFiles
    With myFile
        If Left(.Name, 11) = "FilterString" Then
            Debug.Print .Name, .DateCreated, .DateLastAccessed, .DateLastModified
            
        End If
    End With
Next myFile

End Sub

Workbook オブジェクトを取得する

　Workbook オブジェクトの取得には直感と異なる方法を使う．つまり，Workbooks コレクションに Open メソッドを適用し， Workbook 型の変数に代入して取得する．Workbook オブジェクトに Open メソッドは存在しないので注意が必要である．

　通常なら，下記のコメントアウトした 17 行目のようにファイル名を引数として記述するのが普通である．しかし，なぜか実行時エラー 1004 が発生して Workbook オブジェクトを取得することができない．

Microsoft Visual Basic 実行時エラー '1004':申し訳ございません．***.xlsが見つかりません．名前が変更されたか，移動や削除が行われた可能性があります． — Microsoft Visual Basic 実行時エラー ‘1004’:申し訳ございません．***.xlsが見つかりません．名前が変更されたか，移動や削除が行われた可能性があります．

　検索するとファイルが存在しないのが原因として最多であるとわかる．しかし，実際にファイルは存在している．その後試行錯誤して 18 行目のようにファイルパスを引数として渡すとエラーが発生せず問題なく実行できることがわかった．

　ループ内で Workbook を開いた後は 19 行目のように閉じておく．さもないと処理が終わった後に大量のブックが開きっぱなしになる．

Sub sample()

Dim myFSO   As Scripting.FileSystemObject
Set myFSO = New Scripting.FileSystemObject

Dim myFiles As Scripting.Files
Dim myFile  As Scripting.File

Set myFiles = myFSO.GetFolder(ThisWorkbook.Path).Files

Dim myWB    As Workbook

For Each myFile In myFiles
    With myFile
        If Left(.Name, 11) = "FilterString" Then
            'Debug.Print .Name, .DateCreated, .DateLastAccessed, .DateLastModified
            'Set myWB = Workbooks.Open(myFile.Name)
            Set myWB = Workbooks.Open(myFile.Path)
            myWB.Close
        End If
    End With
Next myFile

End Sub

Worksheet オブジェクトを取得する

　Workbook 内の Worksheets コレクションをループして変数 mySh で Worksheet オブジェクトを取得する．

Sub sample()

Dim myFSO   As Scripting.FileSystemObject
Set myFSO = New Scripting.FileSystemObject

Dim myFiles As Scripting.Files
Dim myFile  As Scripting.File

Set myFiles = myFSO.GetFolder(ThisWorkbook.Path).Files

Dim myWB    As Workbook
Dim mySh    As Worksheet

For Each myFile In myFiles
    With myFile
        If Left(.Name, 11) = "FilterString" Then
            'Debug.Print .Name, .DateCreated, .DateLastAccessed, .DateLastModified
            Set myWB = Workbooks.Open(myFile.Path)
            For Each mySh In myWB.Worksheets
                Debug.Print mySh.Name
            Next mySh
            myWB.Close
        End If
    End With
Next myFile

End Sub

Range オブジェクトを取得する

　24 行目でヘッダー行を含めて Range オブジェクトを取得し，25 行目でヘッダー行をオフセットしている．

Sub sample()

Dim myFSO   As Scripting.FileSystemObject
Set myFSO = New Scripting.FileSystemObject

Dim myFiles As Scripting.Files
Dim myFile  As Scripting.File

Set myFiles = myFSO.GetFolder(ThisWorkbook.Path).Files
'Debug.Print ThisWorkbook.Path

Dim myWB    As Workbook
Dim mySh    As Worksheet
Dim myRng   As Range

For Each myFile In myFiles
    With myFile
        If Left(.Name, 11) = "FilterString" Then
            'Debug.Print .Name, .DateCreated, .DateLastAccessed, .DateLastModified
            Set myWB = Workbooks.Open(myFile.Path)
            For Each mySh In myWB.Worksheets
                'Debug.Print mySh.Name
                With mySh
                    Set myRng = Intersect(.Range("A:D"), , Range("A1").CurrentRegion)
                    Set myRng = myRng.Resize(myRng.Rows.Count - 1).Offset(1)
                    
                End With
            Next mySh
            myWB.Close
        End If
    End With
Next myFile

End Sub

Range オブジェクトから配列にデータを渡す

　Range オブジェクトが取得できたら配列にデータを渡す．ここから先はメモリ上で処理が完結するため処理速度の向上が見込める．

Range オブジェクトを二次元配列に格納し，各列ごとに一次元配列に格納する

　37 行目で Variant 型変数 myVar に Range オブジェクト myRng を代入して二次元配列を得ている．その後，ID, 氏名，日付，テスト結果を示す myID(), myName(), myDate(), myTest() の各変数を，値を保持しつつサイズを一つづつ大きくしている．動的配列の基本的な構文である．

　いったん二次元配列に格納しておきながら，その後一次元配列に格納し直しているのは，二次元配列は列方向にサイズを大きくすることができないためである．

Sub sample()

Dim myFSO   As Scripting.FileSystemObject
Set myFSO = New Scripting.FileSystemObject

Dim myFiles As Scripting.Files
Dim myFile  As Scripting.File

Set myFiles = myFSO.GetFolder(ThisWorkbook.Path).Files
'Debug.Print ThisWorkbook.Path

Dim myWB    As Workbook
Dim mySh    As Worksheet
Dim myRng   As Range

Dim myVar       As Variant
Dim i           As Long
Dim myID()      As String
Dim myName()    As String
Dim myDate()    As Date
Dim myTest()    As Single

Dim j       As Long

j = 0
For Each myFile In myFiles
    With myFile
        If Left(.Name, 11) = "FilterString" Then
            'Debug.Print .Name, .DateCreated, .DateLastAccessed, .DateLastModified
            
            Set myWB = Workbooks.Open(myFile.Path)
            For Each mySh In myWB.Worksheets
                'Debug.Print mySh.Name
                With mySh
                    Set myRng = Intersect(.Range("A:D"), , Range("A1").CurrentRegion)
                    Set myRng = myRng.Resize(myRng.Rows.Count - 1).Offset(1)
                    myVar = myRng
                    For i = LBound(myVar) To UBound(myVar)
                        ReDim Preserve myID(j)
                        ReDim Preserve myName(j)
                        ReDim Preserve myDate(j)
                        ReDim Preserve myTest(j)
                        
                        myID(j) = myVar(i, 1)
                        myName(j) = myVar(i, 2)
                        myDate(j) = myVar(i, 3)
                        myTest(j) = myVar(i, 4)
                        j = j + 1
                        
                    Next i
                End With
            Next mySh
            myWB.Close
        End If
    End With
Next myFile

End Sub

一次元配列を二次元配列に統合する

　Variant 型の変数 myAr() を宣言し，ループして myID, myName, myDate, myTest の内容を格納する．

Dim myAr()  As Variant

ReDim myAr(LBound(myID) To UBound(myAr), 1 To 4)
For j = LBound(myID) To UBound(myID)
    myAr(j, 1) = myID(j)
    myAr(j, 2) = myName(j)
    myAr(j, 3) = myDate(j)
    myAr(j, 4) = myTest(j)
Next j

ワークシートに書き込む

　変数 myAr を代入してワークシートに書き込む．範囲は上記コードの j の最大値を確認してから決めること．

ThisWorkbook.Worksheets(1).Range("A2:D" & j + 1) = myAr

Microsoft Scripting Runtime ライブラリをオブジェクトブラウザーから見る

　ツールメニューから Microsoft Scripting Runtime のチェックをオンオフすると，オブジェクトブラウザーで見えるライブラリに Scripting が現れたり消えたりする．検索ウィンドウにワイルドカードを指定すると，同ライブラリのオブジェクトが一覧できる．

Microsoft Scripting Runtime がオンではライブラリに Scripting が見える

Microsoft Scripting Runtime がオフではライブラリに Scripting は見えない

　オブジェクトには FileSystemObject, File, Files, Folder, Folders, Drive, Drives, Dictionary, Encoder がある．

FileSystemObject

　ファイル，フォルダー，ドライブを扱うオブジェクトである．

MEMBER		Return
BuildPath(Path As String, Name As String)	Function	String
CopyFile(Source As String, Destination As String, [OverWriteFiles As Boolean = True])	Sub
CopyFolder(Source As String, Destination As String, [OverWriteFiles As Boolean = True])	Sub
CreateFolder(Path As String)	Function	Folder
CreateTextFile(FileName As String, [Overwrite As Boolean = True], [Unicode As Boolean = False])	Function	TextStream
DeleteFile(FileSpec As String, [Force As Boolean = False])	Sub
DeleteFolder(FolderSpec As String, [Force As Boolean = False])	Sub
DriveExists(DriveSpec As String)	Function	Boolean
Drives	Property	Drives
FileExists(FileSpec As String)	Function	Boolean
FolderExists(FolderSpec As String)	Function	Boolean
GetAbsolutePathName(Path As String)	Function	String
GetBaseName(Path As String)	Function	String
GetDrive(DriveSpec As String)	Function	Drive
GetDriveName(Path As String)	Function	String
GetExtensionName(Path As String)	Function	String
GetFile(FilePath As String)	Function	File
GetFileName(Path As String)	Function	String
GetFileVersion(FileName As String)	Function	String
GetFolder(FolderPath As String)	Function	Folder
GetParentFolderName(Path As String)	Function	String
GetSpecialFolder(SpecialFolder As SpecialFolderConst)	Function	Folder
GetStandardStream(StandardStreamType As StandardStreamTypes, [Unicode As Boolean = False])	Function	TextStream
GetTempName()	Function	String
MoveFile(Source As String, Destination As String)	Sub
MoveFolder(Source As String, Destination As String)	Sub
OpenTextFile(FileName As String, [IOMode As IOMode = ForReading], [Create As Boolean = False], [Format As Tristate = TristateFalse])	Function	TextStream

File オブジェクト

MEMBER		Type of Return
Attributes	Property	FileAttribute
Copy(Destination As String, [OverWriteFiles As Boolean = True])	Sub
DateCreated	Property	Date
DateLastAccessed	Property	Date
DateLastModified	Property	Date
Delete([Force As Boolean = False])	Sub
Drive	Property	Drive
Move(Destination As String)	Sub
Name	Property	String
OpenAsTextStream([IOMode As IOMode = ForReading], [Format As Tristate = TristateFalse])	Function	TextStream
ParentFolder	Property	Folder
Path	Property	String
ShortName	Property	String
ShortPath	Property	String
Size	Property	Variant
Type	Property	String

Files コレクション

MEMBER		Type of Return
Count	Property	Long
Item(Key)	Property	File
Attributes	Property	FileAttribute
Copy(Destination As String, [OverWriteFiles As Boolean = True])	Sub
CreateTextFile(FileName As String, [Overwrite As Boolean = True], [Unicode As Boolean = False])	Function	TextStream
DateCreated	Property	Date
DateLastAccessed	Property	Date
DateLastModified	Property	Date
Delete([Force As Boolean = False])	Sub
Drive	Property	Drive
Files	Property	Files
IsRootFolder	Property	Boolean
Move(Destination As String)	Sub
Name	Property	String
ParentFolder	Property	Folder
Path	Property	String
ShortName	Property	String
ShortPath	Property	String
Size	Property	Variant
SubFolders	Property	Folders
Type	Property	String