ここでは、指定したフォルダ内にある複数のExcelワークブックを順次開いて処理を行なう例を説明します。
作成済みワークブックを一括して変更したいということはよくあります。
ここでのサンプルは、指定フォルダ内の各ワークブックを順次印刷させるものですが、ここで紹介するのは「フォルダ内の各ワークブックを順次処理する」ことです。
掲示板等でこのページを紹介すると、「紹介ページは印刷ですが、やりたいことは．．．」などと聞き返してくる人もいるのですが、それぞれの方の100％要望の機能をサイトで用意はできません。
今回は、１ファイル単位の処理記述がどの部分なのかをわかるようにしてありますから、１ファイルの中で何をするのかを考えてトライして下さい。
掲示板等でこのページを紹介すると、「紹介ページは印刷ですが、やりたいことは．．．」などと聞き返してくる人もいるのですが、それぞれの方の100％要望の機能をサイトで用意はできません。
今回は、１ファイル単位の処理記述がどの部分なのかをわかるようにしてありますから、１ファイルの中で何をするのかを考えてトライして下さい。
- まずは、Dir関数で、単一フォルダに限っての方法です。
-
サンプルですから「処理」は印刷とします。印刷は指定されたフォルダにある全Excelワークブックに対し、「ブック全体」を指定して印刷します。
シート上のボタンで起動させると、「フォルダの参照」のフォームが表示されます。
(画像をクリックすると、このサンプルがダウンロードできます)
ここで、Excelワークブックが収容されているフォルダを指定してOKをクリックすると、そのフォルダにある全部のExcelワークブックの全シートについて順次一括して印刷が行なわれます。
Excelワークブックが存在しないワークブックを指定したり、キャンセルすると、
のメッセージが表示されます。
単一フォルダの場合はこの方法でも構いませんが、配下のサブフォルダまで処理させる必要がある場合には、このページ後半の再帰動作の方法をおためし下さい。
では、ソースコードです。
要点の説明は以下のようになります。'*************************************************************************************************** ' 指定フォルダ内の全てのワークブックの全シートを印刷 Module1(Module) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '03/07/28(1.00)新規作成 '14/01/28(1.10)FolderPickerの共通モジュール変更 '20/02/29(1.11)*.xlsm化、他 '*************************************************************************************************** Option Explicit '=================================================================================================== Private Const g_cnsTitle As String = "指定フォルダ内の全てのワークブックの全シートを印刷" Private Const g_cnsYen As String = "\" '*************************************************************************************************** ' ■■■ ワークシート側からの呼び出し処理 ■■■ '*************************************************************************************************** '* 処理名 ：Button1_Click '* 機能 ：指定フォルダ内の全てのワークブックの全シートを印刷 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2003年07月27日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月29日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Sub Button1_Click() '----------------------------------------------------------------------------------------------- Dim strPathname As String ' フォルダ名(パス名) Dim strFilename As String ' ファイル名 Dim swEsc As Boolean ' Escキー判定 '----------------------------------------------------------------- ' ｢フォルダの参照｣よりフォルダ名の取得(modFolderPicker2に収容) strPathname = modFolderPicker2.FolderDialog("フォルダを指定して下さい", True) ' 未指定は終了 If strPathname = "" Then Exit Sub ' 指定フォルダ内のExcelワークブックのファイル名を参照する(1件目) strFilename = Dir(strPathname & "\*.xl*", vbNormal) ' ←※① ' 検索ファイル無し If strFilename = "" Then MsgBox "このフォルダにはExcelワークブックは存在しません。", vbExclamation, g_cnsTitle Exit Sub End If '----------------------------------------------------------------- ' 画面描画停止 With Application .ScreenUpdating = False ' 画面描画停止 .EnableEvents = False ' イベント動作停止 .EnableCancelKey = xlErrorHandler ' Escキーでエラートラップする .Cursor = xlWait ' カーソルを砂時計にする End With On Error GoTo Button1_Click_ERROR '----------------------------------------------------------------- ' 指定フォルダの全Excelワークブックについて繰り返す Do While strFilename <> "" DoEvents ' Escキー打鍵判定 If swEsc Then ' 中断するのかをメッセージで確認 If MsgBox("中断キーが押されました。ここで終了しますか？", _ vbInformation + vbYesNo, g_cnsTitle) = vbYes Then GoTo Button1_Click_EXIT Else swEsc = False End If End If '------------------------------------------------------------- ' １ファイル単位の処理 Call GP_AboutBookProc(strPathname, strFilename) ' ←※② '------------------------------------------------------------- ' 次のファイル名を参照 strFilename = Dir ' ←※③ Loop GoTo Button1_Click_EXIT '=================================================================================================== ' Escキー脱出用行ラベル Button1_Click_ERROR: ' エラー内容判定 If Err.Number = 18 Then ' EscキーでのエラーRaise swEsc = True Resume ElseIf Err.Number = 1004 Then ' 隠しシートや印刷対象なしの実行時エラーは無視 Resume Next Else ' その他のエラーはメッセージ表示後終了 MsgBox Err.Description End If '=================================================================================================== ' 処理終了 Button1_Click_EXIT: With Application .StatusBar = False ' ステータスバーを復帰 .EnableEvents = True ' イベント動作再開 .EnableCancelKey = xlInterrupt ' Escキー動作を戻す .Cursor = xlDefault ' カーソルをデフォルトに戻す .ScreenUpdating = True ' 画面描画再開 End With End Sub '*************************************************************************************************** ' ■■■ サブ処理(Private) ■■■ '*************************************************************************************************** '* 処理名 ：GP_AboutBookProc '* 機能 ：１つのワークブックの処理(このサンプルでは全シート印刷) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = フォルダ名(String) '* Arg2 = ファイル名(String) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2003年07月27日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月29日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub GP_AboutBookProc(ByVal strPathname As String, ByVal strFilename As String) '----------------------------------------------------------------------------------------------- Dim objWbk As Workbook ' ワークブックObject Dim strFullname As String ' フルパスファイル名 ' フルパスファイル名の編集 strFullname = strPathname & g_cnsYen & strFilename ' ステータスバーに処理ファイル名を表示 Application.StatusBar = strFilename & " 印刷中．．．．" ' ワークブックを開く(このサンプルでは読み取り専用) Set objWbk = Workbooks.Open(Filename:=strFullname, UpdateLinks:=False, ReadOnly:=True) '----------------------------------------------------------------- ' ↓↓↓ 検索した１ファイル単位の処理 ↓↓↓ ' 全シートを印刷 objWbk.PrintOut 'objWBK.PrintPreview ' ※お試し用(プレビュー) ' ↑↑↑ 検索した１ファイル単位の処理 ↑↑↑ '----------------------------------------------------------------- ' 開いたブックをClose(必要であれば保存して下さい) objWbk.Close SaveChanges:=False Set objWbk = Nothing End Sub '----------------------------------------<< End of Source >>----------------------------------------
ということで、１フォルダ内に収まっているExcelワークブックを順次開いていって「何かの処理」を行なうという場合にはこのような方法を採ります。№ 概略説明 ※① Dir関数で1件目のファイル名を受け取ります。 Dir関数に指定フォルダを渡す時に「\*.xl*"」を付加させているので、ほぼExcelワークブックが検索されます。
(完全な方法ではありません)
※② 検索された1ファイルに対する処理になります。
※③ 次のファイル名を受け取ります。
このサンプルでは１つのExcelワークブックについての処理を「GP_AboutBookProc」プロシージャに出してあるので、ここだけ要件によって書き直すようなことでも要求は満たせるのかも知れません。
※「objWBK.PrintPreview」を有効にする場合は初期処理の「.ScreenUpdating = False」をコメントにして下さい。
※「中断機能」を付けたことでコードが長くなり、初心者の方には難しく見えてしまうかも知れませんが、誤操作の場合に処理を早急に止められるように実装しておく必要がある機能ですから、これらも含めて内容を理解して下さい。
- FSO(FileSystemObject)を使った再帰動作です。サブフォルダも探索されます。
-
以前は「FileSearchオブジェクト」でサブフォルダも探索されるサンプルを置いていたのですが、Office 2007以降で動かないということになったので、
FSO(FileSystemObject)を使って再帰動作させるサンプルに変更しました。
サブフォルダも探索される件を除くと、動きは上のサンプルと同じです。
(ここをクリックすると、このサンプルがダウンロードできます)'*************************************************************************************************** ' 指定フォルダ内の全てのワークブックの全シートを印刷(FSO) Module2(Module) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '20/02/29(1.00)新規作成 '*************************************************************************************************** Option Explicit '=================================================================================================== Private Const g_cnsTitle As String = "指定フォルダ内の全てのワークブックの全シートを印刷" '*************************************************************************************************** ' ■■■ ワークシート側からの呼び出し処理 ■■■ '*************************************************************************************************** '* 処理名 ：Button1_Click '* 機能 ：指定フォルダ内の全てのワークブックの全シートを印刷 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2020年02月29日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月29日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Sub Button1_Click() '----------------------------------------------------------------------------------------------- Dim objFso As FileSystemObject ' FileSystemObject Dim cntFolder As Long ' フォルダ数カウンタ Dim cntFile As Long ' ファイル数カウンタ Dim cntBook As Long ' 対象ワークブック数カウンタ Dim blnResult As Boolean ' 処理成否 Dim strRootFolder As String ' ルートフォルダ '----------------------------------------------------------------- ' ルートとなるフォルダの指定(※modFolderPicker2.bas) strRootFolder = modFolderPicker2.FolderDialog("ルートフォルダを指定して下さい。") ' 未指定は終了 If strRootFolder = "" Then Exit Sub '----------------------------------------------------------------- ' 画面描画停止 With Application .ScreenUpdating = False ' 画面描画停止 .EnableEvents = False ' イベント動作停止 .EnableCancelKey = xlErrorHandler ' Escキーでエラートラップする .Cursor = xlWait ' カーソルを砂時計にする End With ' 処理開始 Set objFso = New FileSystemObject '----------------------------------------------------------------- ' ルートフォルダから探索開始 blnResult = FP_FolderProc(objFso, objFso.GetFolder(strRootFolder), cntFolder, cntFile, cntBook) '----------------------------------------------------------------- ' 処理完了 Set objFso = Nothing ' 画面描画再開 With Application .StatusBar = False ' ステータスバーを復帰 .EnableEvents = True ' イベント動作再開 .EnableCancelKey = xlInterrupt ' Escキー動作を戻す .Cursor = xlDefault ' カーソルをデフォルトに戻す .ScreenUpdating = True ' 画面描画再開 End With ' 結果表示 If blnResult Then MsgBox "処理が完了しました。" & vbCr & vbCr & _ "フォルダ数=" & cntFolder & vbCr & _ "ファイル数=" & cntFile & vbCr & _ "処理ブック=" & cntBook, vbInformation End If End Sub '*************************************************************************************************** ' ■■■ サブ処理(Private) ■■■ '*************************************************************************************************** '* 処理名 ：FP_FolderProc '* 機能 ：フォルダ単位処理 '--------------------------------------------------------------------------------------------------- '* 返り値 ：処理成否(Boolean) '* 引数 ：Arg1 = FileSystemObject(Object) '* Arg2 = フォルダ(Object) '* Arg3 = フォルダ数カウンタ(Long) ※Ref参照 '* Arg4 = ファイル数カウンタ(Long) ※Ref参照 '* Arg5 = 対象ワークブック数カウンタ(Long) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2020年02月29日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月29日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：本処理は再帰動作 '*************************************************************************************************** Private Function FP_FolderProc(ByRef objFso As FileSystemObject, _ ByVal objFolder As Folder, _ ByRef cntFolder As Long, _ ByRef cntFile As Long, _ ByRef cntBook As Long) As Boolean '----------------------------------------------------------------------------------------------- Dim objSubFolder As Folder ' サブフォルダ Dim objFile As File ' ファイル FP_FolderProc = False cntFolder = cntFolder + 1 ' 参照フォルダ数を加算 '----------------------------------------------------------------- ' ■先ずサブフォルダを探索 For Each objSubFolder In objFolder.SubFolders ' フォルダ単位処理(再帰呼び出し) If Not FP_FolderProc(objFso, objSubFolder, cntFolder, cntFile, cntBook) Then Exit Function Next objSubFolder '----------------------------------------------------------------- On Error GoTo FolderProc_ERROR ' 処理フォルダを表示 Application.StatusBar = objFolder.Name & " 処理中．．．．" ' ■本フォルダの各ファイルを探索 For Each objFile In objFolder.Files cntFile = cntFile + 1 ' 参照ファイル数 ' ファイル単位処理 Call GP_FileProc(objFso, objFile, cntBook) Next objFile FP_FolderProc = True GoTo FolderProc_EXIT '=================================================================================================== ' 実行時エラー処理 FolderProc_ERROR: ' エラー内容判定 If Err.Number = 18 Then ' Escキー打鍵は終了確認 If MsgBox("中断キーが押されました。ここで終了しますか？", _ vbInformation + vbYesNo, g_cnsTitle) = vbYes Then GoTo FolderProc_EXIT Else Resume End If ElseIf Err.Number = 1004 Then ' 隠しシートや印刷対象なしの実行時エラー等は無視 Resume Next Else ' その他のエラーはメッセージ表示後終了 MsgBox Err.Description, vbCritical, g_cnsTitle End If '=================================================================================================== ' 終了 FolderProc_EXIT: ' 参照Objectを破棄 Set objFolder = Nothing On Error GoTo 0 End Function '*************************************************************************************************** '* 処理名 ：GP_FileProc '* 機能 ：ファイル単位処理 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = FileSystemObject(Object) '* Arg2 = ファイル(Object) '* Arg3 = 対象ワークブック数カウンタ(Long) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2020年02月29日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月29日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub GP_FileProc(ByRef objFso As FileSystemObject, _ ByVal objFile As File, _ ByRef cntBook As Long) '----------------------------------------------------------------------------------------------- Dim strFullname As String ' フルパスファイル名 Dim strExtU As String ' 拡張子(大文字) ' 拡張子取得 strExtU = UCase(objFso.GetExtensionName(objFile.Name)) ' 拡張子がExcelワークブックか判定 If ((strExtU = "XLS") Or (strExtU = "XLSX") Or (strExtU = "XLSM") Or (strExtU = "XLSB")) Then cntBook = cntBook + 1 ' 参照ブック数 ' ステータスバーに処理ファイル名を表示 Application.StatusBar = objFile.Name & " 処理中．．．．" strFullname = objFso.BuildPath(objFile.Path, objFile.Name) ' ワークブック単位処理 Call GP_AboutBookProc(strFullname) End If End Sub '*************************************************************************************************** '* 処理名 ：GP_AboutBookProc '* 機能 ：ワークブック単位処理(このサンプルでは全シート印刷) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = フルパスファイル名(String) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2020年02月29日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月29日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub GP_AboutBookProc(ByVal strFullname As String) '----------------------------------------------------------------------------------------------- Dim objWbk As Workbook ' ワークブックObject ' ワークブックを開く(このサンプルでは読み取り専用) Set objWbk = Workbooks.Open(Filename:=strFullname, UpdateLinks:=False, ReadOnly:=True) '----------------------------------------------------------------- ' ↓↓↓ 検索した１ファイル単位の処理 ↓↓↓ ' 全シートを印刷 objWbk.PrintOut 'objWBK.PrintPreview ' ※お試し用(プレビュー) ' ↑↑↑ 検索した１ファイル単位の処理 ↑↑↑ '----------------------------------------------------------------- ' 開いたブックをClose(必要であれば保存して下さい) objWbk.Close SaveChanges:=False Set objWbk = Nothing End Sub '----------------------------------------<< End of Source >>----------------------------------------
再帰動作については「フォルダ内のファイル一覧の取得」で説明しているので、詳細説明は割愛しますが、 ここでは「フォルダ単位処理(FP_FolderProc)」で再帰動作が行なわれます。
上で説明したDir関数を異なり、検索動作はしないので各フォルダのファイルを全て受け取ってから「Excelワークブック」かを判定するといった動作になっています。