Excel VBA ファイル操作

Excel VBA のトップに戻る
Excel VBA 目次

索引

フォルダ内の指定拡張子のファイルを名前のプレフィックスでカウント
([ファイルを開く]ダイアログボックスで、ファイルを指定)

 指定するフォルダにある複数ファイルのファイル数をファイル名の接頭辞で集計したいことかあります。
 ここで紹介するマクロは、フォルダ、ファイル操作に、ファイル・システム・オブジェクトを利用しています。

 このマクロは、指定フォルダの直下のファイルのみを、対象としています。
このマクロをダウンロードできます。→CountFileNamePrefixVBA02.xls

Option Explicit
Option Base 1


Sub ファイル名先頭文字でカウント()

   Dim ファイルシステムオブジェクト As Object          ' FileSystemObject
   Dim ファイルオブジェクト As Object
   Dim フォルダパス As String
   Dim ファイルパス As String
   Dim 接頭辞カウント(1000, 2) As Variant
   Dim 接頭辞辞書 As Object '★連想配列
   Dim 拡張子 As String
   Dim 桁数 As Integer
   Dim ファイル名 As String
   Dim 接頭辞 As String
   Dim カウンタ As Integer
   Dim 最終行 As Integer

   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

   Set 接頭辞辞書 = CreateObject("Scripting.Dictionary") '★連想配列の定義
   
   拡張子 = ThisWorkbook.Worksheets("スタート").Range("A2").Value
   桁数 = ThisWorkbook.Worksheets("スタート").Range("B2").Value
   カウンタ = 0
   
   '[ファイルを開く]ダイアログボックスで、ファイルを指定して、パスを取得
   ChDir ThisWorkbook.Path 'デフォルトのパスをこのExcelファイルのフォルダに変更
   ファイルパス = Application.GetOpenFilename(",*." & 拡張子)
   
   '[ファイルを開く]で「キャンセル」した場合は、処理を終了
   If ファイルパス = "False" Then End
   
   'ファイルパスから、フォルダパスを取得
   フォルダパス = ファイルシステムオブジェクト.GetParentFolderName(ファイルパス)

   '上で指定したフォルダ内の、全ての対象拡張子を検索
    For Each ファイルオブジェクト In ファイルシステムオブジェクト.GetFolder(フォルダパス).Files

      If 拡張子 = ファイルシステムオブジェクト.GetExtensionName(ファイルオブジェクト.Name) Then

         ファイル名 = ファイルオブジェクト.Name
         接頭辞 = Left(ファイル名, 桁数)
         
         If 接頭辞辞書.Exists(接頭辞) = False Then
            カウンタ = カウンタ + 1
            接頭辞辞書.Add 接頭辞, カウンタ
            接頭辞カウント(カウンタ, 1) = 接頭辞
            接頭辞カウント(カウンタ, 2) = 1
         Else
            接頭辞カウント(接頭辞辞書.Item(接頭辞), 2) = 接頭辞カウント(接頭辞辞書.Item(接頭辞), 2) + 1
         End If

      End If
   Next ファイルオブジェクト
   
   '既存データの2行目以降を行削除する
   Worksheets("接頭辞カウント").Activate
   'A 列(1列目)を基準に、最終行を求める
   最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
   If 最終行 > 1 Then
      Rows(2 & ":" & 最終行).Delete Shift:=xlUp '単純な Cells.Clear だとムダな空白行が残ってしまう
   End If
   '集計結果を登録
   ThisWorkbook.Worksheets("接頭辞カウント").Range("A1").Value = "接頭辞"
   ThisWorkbook.Worksheets("接頭辞カウント").Range("B1").Value = "カウント"
   ThisWorkbook.Worksheets("接頭辞カウント").Range("A2").Resize(カウンタ, 2) = 接頭辞カウント
   'カウントの降順でソート
   Range("A1").CurrentRegion.Sort _
      Key1:=Range("B2"), Order1:=xlDescending, _
      Header:=xlYes

   Set 接頭辞辞書 = Nothing '★連想配列を削除
   Set ファイルシステムオブジェクト = Nothing
   MsgBox "終了しました"

End Sub
この種類の目次に戻る↑ 索引へ↓ トップページに戻る


フォルダ内のファイルを検索

 指定するフォルダにある複数ファイルのデータを、串刺しして集計したり、検索して処理したいことかあります。
 ここで紹介する例は、各支社から、統一のExcelファイル形式で毎月初に送られてくる、多数の月報ファイルを、月別のフォルダに登録しておいて、そのExcelファイル群からデータを抽出して、総括表を作るときに使うものです。

 このマクロは、指定フォルダの直下のファイルのみを、対象として、ファイル検索に FileSearch オブジェクトを利用しています。
 サブ・フォルダの中身も対象にしたい場合は、「指定フォルダのサブ・フォルダの構成ファイルも含めて、指定拡張子のファイルを拡張子を変更してコピー」を参照下さい。


Option Explicit

Sub Excelブックの串刺し集計@()

Dim フォルダパス As String
Dim ブック指定 As Variant
Dim 行 As Integer
Dim 列 As Integer
Dim ファイル As Integer
Dim データ(1000, 5) As Variant

   '画面表示を止めて、処理を高速化
   Application.ScreenUpdating = False
   
   '[ファイルを開く]ダイアログボックスで、ファイルを指定して、パスを取得
   フォルダパス = Application.GetOpenFilename("Excelファイル,*.xls")
   
   '[ファイルを開く]で「キャンセル」した場合は、処理を終了
   If フォルダパス = "False" Then End
   
   'フォルダパスから、後ろのファイル名の部分を削除して、フォルダ・パスに変更
   フォルダパス = Left(フォルダパス, InStrRev(フォルダパス, "\"))

   'Excelのシート構成が違ってもエラーで止まらないようにする。
    On Error Resume Next

   '上で指定したフォルダ内の、全てのExcelファイルを対象に検索
   With Application.FileSearch
       .LookIn = フォルダパス
       .Filename = "*.xls"
   
      If .Execute > 0 Then
         For ファイル = 1 To .FoundFiles.Count
            Workbooks.Open Filename:=.FoundFiles(ファイル), UpdateLinks:=0, ReadOnly:=True
             'リンクを更新せずに、読み取り専用で、ブックを開く
            データ(ファイル, 1) = ActiveWorkbook.Worksheets("売上").Range("A11").Value
            データ(ファイル, 2) = ActiveWorkbook.Worksheets("損益").Range("C2").Value
            
            For 行 = 1 To 3
                データ(ファイル, 行 + 2) _
                = ActiveWorkbook.Worksheets("棚卸資産").Range("CB17").Cells(行 * 8, 1).Value
            Next 行
            
            ActiveWorkbook.Close False
         Next ファイル
      End If
   End With
   
  
   ThisWorkbook.Worksheets("sheet1").Activate
   
   For 行 = 1 To ファイル
     For 列 = 1 To 5
       ThisWorkbook.Worksheets("sheet1").Range("A5").Cells(行, 列) = データ(行, 列)
     Next 列
   Next 行
   
   Application.ScreenUpdating = True

End Sub

 解説:
 FileSearch プロパティは、アプリケーション情報ファイル検索で使用される FileSearch オブジェクトを返します。

注:FileSearch は、Excel 2007 から使えなくなります。そのため、FileSystemObject オブジェクト を使うと良いでしょう。

 次の使用例は、[マイ ドキュメント] フォルダにあるすべての Excel ブックを表す FoundFiles オブジェクトを作成します。


With Application.FileSearch
    .LookIn = "c:\my documents"
    .FileType = msoFileTypeExcelWorkbooks
    .Execute
End With


 FileSearch オブジェクトは、[ファイルを開く] ダイアログ ボックス ([ファイル] メニュー) の機能を表します。

 検索条件を既定の設定にリセットするには、NewSearch メソッドを使用します。
 すべてのプロパティの値は、検索を実行した後も保持されます。NewSearch メソッドを使用すると、別の条件でファイルを検索するときに、前のプロパティの値を 1 つずつ削除または変更しなくても、新しいプロパティの値をすぐに設定できます。

 次の使用例は、検索条件を既定の設定にリセットした後、新しい検索を開始します。


With Application.FileSearch
    .NewSearch
    .LookIn = "C:\My Documents"
    .SearchSubFolders = True 'サブ・フォルダも含めて検索します。
    .FileName = "Run"
    .MatchTextExactly = True
    .FileType = msoFileTypeAllFiles
End With

 FoundFiles オブジェクトは、ファイル検索で見つかったファイルの一覧を表します。

 FoundFiles オブジェクトを取得するには、FoundFiles プロパティを使用します。

 次の使用例は、ファイル検索で見つかったファイルの一覧をチェックし、見つかったファイルの総数と、各ファイルのパスとファイル名を表示します。
 各ファイルのパスとファイル名を取得するには、FoundFiles(index) を使用します。ここで、index はファイルのインデックス番号を表します。


With Application.FileSearch
    If .Execute() > 0 Then
        MsgBox .FoundFiles.Count & " 個のファイルが見つかりました。"           
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "検索条件を満たすファイルはありません。"
    End If
End With

 ファイル検索を開始して FoundFiles オブジェクトを更新するには、Execute メソッドを使用します。
 次の使用例は、[マイ ドキュメント] フォルダの中で、ファイル名が "cmd" で始まるすべてのファイルを検索し、条件を満たすファイルの名前と保存場所の一覧を表示します。また、検索結果のファイル一覧を、ファイル名の昇順で並べ替えます。


With Application.FileSearch
    .LookIn = "C:\My Documents"
    .FileName = "cmd*"
    If .Execute(SortBy:=msoSortbyFileName, _
    SortOrder:=msoSortOrderAscending) > 0 Then
        MsgBox "見つかったファイルは  " & .FoundFiles.Count & _
            "  ファイルです。"
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "ファイルが見つかりません。"
    End If
End With

 FileSearch オブジェクトの Execute メソッドは、指定したファイルの検索を開始します。長整数型 (Long) の値を返します。ファイルが見つからなかった場合は 0、1 つ以上のファイルが見つかった場合は正の数を返します。

expression.Execute(SortBy, SortOrder, AlwaysAccurate)

 expression 必ず指定します。FileSearch オブジェクトを表すオブジェクト式を指定します。

 SortBy 省略可能です。MsoSortBy クラスの定数を指定します。取得したファイルを並べ替える方法を指定します。

使用できる定数は、次に示す MsoSortBy クラスの定数のいずれかです。
msoSortByFileName 既定値
msoSortByFileType
msoSortByLastModified
msoSortByNone
msoSortBySize

 SortOrder 省略可能です。MsoSortOrder クラスの定数を指定します。取得したファイルを並べ替える順序を指定します。

使用できる定数は、次に示す MsoSortOrder クラスの定数のいずれかです。
msoSortOrderAscending 既定値
msoSortOrderDescending

 AlwaysAccurate 省略可能です。ブール型 (Boolean) の値を指定します。True を指定すると、ファイル一覧が最後に更新されてから追加、変更、または削除されたファイルも検索の対象に含まれます。既定値は True です。


 Open メソッドを Workbooks コレクション オブジェクトに指定した場合は、ブックを開きます。

expression.Open(FileName, UpdateLinks, ReadOnly, Format, Password, WriteResPassword, IgnoreReadOnlyRecommended, Origin, Delimiter, Editable, Notify, Converter, AddToMru, Local, CorruptLoad)

expression 必ず指定します。Workbooks コレクションを返すオブジェクト式を指定します。

FileName 必ず指定します。文字列型 (String) の値を使用します。開くブックのファイル名を指定します。

 UpdateLinks 省略可能です。バリアント型 (Variant) の値を使用します。ファイル内のリンクの更新方法を指定します。
リンクが設定されているファイルを開くとき、この引数を省略すると、リンク更新のダイアログ ボックスが表示されます。
次のいずれかの値を指定します。リンクを更新せずに開かせる場合は、0 を指定します。
内容
0外部参照とリモート参照は共に更新されません。
1外部参照は更新され、リモート参照は更新されません。
2リモート参照は更新され、外部参照は更新されません。
3外部参照とリモート参照は共に更新されます。

 Excel は、引数 UpdateLinks に 2 を設定して、WKS、WK1、WK3、WJ1、WJ2 形式のファイルを開いたときに、Lotus 1-2-3 のファイルに付いているグラフから、グラフを作成します。引数を 0 に設定したときは、グラフは作成されません。

 ReadOnly 省略可能です。バリアント型 (Variant) の値を使用します。ブックを読み取り専用モードで開くには、True を指定します。

 Format 省略可能です。バリアント型 (Variant) の値を使用します。Excel がテキスト ファイルを開くときに、この引数に項目の区切り文字を指定します。指定できる区切り文字は次のとおりです。この引数を省略すると、現在指定されている区切り文字が使われます。

区切り文字
1タブ
2カンマ (,)
3スペース
4セミコロン (;)
5なし
6引数 Delimiter で指定された文字

 Password 省略可能です。バリアント型 (Variant) の値を使用します。パスワード保護されたブックを開くのに必要なパスワードを指定します。パスワードが必要なときにこの引数を省略すると、パスワードの入力を促すダイアログ ボックスが表示されます。

 WriteResPassword 省略可能です。バリアント型 (Variant) の値を使用します。書き込み保護されたブックに書き込みをするために必要なパスワードを指定します。パスワードが必要なときにこの引数を省略すると、パスワードの入力を促すダイアログ ボックスが表示されます。

 IgnoreReadOnlyRecommended 省略可能です。バリアント型 (Variant) の値を使用します。[読み取り専用を推奨する] チェック ボックスをオンにして保存されたブックを開くときでも、読み取り専用を推奨するメッセージを非表示にするには、True を指定します。

 Origin 省略可能です。バリアント型 (Variant) の値を使用します。引数 FileName に指定したファイルがテキスト ファイルのときに、それがどのような形式のテキスト ファイルかを指定します。コード ページと CR/LF を正しく変換するために必要です。使用できる定数は、XlPlatform クラスの xlMacintosh、xlWindows、xlMSDOS のいずれかです。この引数を省略すると、現在のオペレーティング システムの形式が使われます。この引数は、日本版 Excel ではサポートされていません。ただし、インターナショナルなアプリケーションを作成する場合には指定する必要がある場合もあります。

 Delimiter 省略可能です。バリアント型 (Variant) の値を使用します。引数 FileName に指定したファイルがテキスト ファイルであり、引数 Format に 6 が設定されているときに、区切り記号として使う文字を指定します。たとえば、タブの場合は Chr(9)、カンマの場合は ","、セミコロンの場合は ";" を指定します。任意の文字を指定することもできます。文字列を指定したときは、最初の文字だけが使われます。

 Editable 省略可能です。バリアント型 (Variant) の値を使用します。指定したファイルが Excel 4.0 のアドインの場合、この引数に True を指定すると、アドインをウィンドウとして表示します。この引数に False を指定するか省略すると、アドインは非表示の状態で開かれ、ウィンドウとして表示することはできません。この引数は、Excel 5.0 以降のアドインには適用されません。指定したファイルが Excel のテンプレートの場合、True を指定すると、指定されたテンプレートを編集用に開きます。False を指定すると、指定されたテンプレートを基にした、新しいブックを開きます。既定値は False です。

 Notify 省略可能です。バリアント型 (Variant) の値を使用します。引数 FileName に指定したファイルが読み取り/書き込みモードで開けない場合に、ファイルを通知リストに追加するには、True を指定します。ファイルは読み取り専用モードで開かれて通知リストに追加され、ブックを編集できる状態になった時点で、ユーザーにその旨が通知されます。ファイルが開けない場合に、このような通知を行わずにエラーを発生させるには、False を指定するか省略します。

 Converter 省略可能です。バリアント型 (Variant) の値を使用します。ファイルを開くときに、最初に使うファイル コンバータのインデックス番号を指定します。指定したファイル コンバータでファイルが変換できない場合は、ほかのすべてのファイル コンバータでの変換が試みられます。指定するインデックス番号は、FileConverters プロパティで返されるファイル コンバータの行番号です。

 AddToMru 省略可能です。バリアント型 (Variant) の値を使用します。最近使用したファイルの一覧にブックを追加するには True を指定します。既定値は False です。

 Local 省略可能です。バリアント型 (Variant) の値を使用します。Excel の言語設定 (コントロール パネルの設定を含む) に合わせてファイルを保存するには、True を指定します。Visual Basic for Applications (VBA) の言語設定に合わせてファイルを保存するには、False (既定値) を指定します。通常この設定は、Workbooks.Open を実行する VBA プロジェクトが Excel バージョン 5 または 95 の各国語版で作成されたプロジェクトでない限り、英語 (U.S.) になります。

 CorruptLoad 省略可能です。バリアント型 (Variant) の値を使用します。使用できる定数は、xlNormalLoad、xlRepairFile、xlExtractData のいずれかです。この引数を省略したときの既定の動作は、標準の読み込み処理となるのが普通ですが、場合によっては、2 回目以降は修復読み込みやデータの修復となることがあります。つまり、最初は標準の読み込み処理を試みます。ファイルを開いている途中で処理が停止したときは、次に修復読み込みを試みます。再び処理が停止したときは、次にデータの修復を試みます。

 次の使用例は、Analysis.xls というブックを開き、Auto_Open マクロを実行します。


Workbooks.Open "ANALYSIS.XLS"
ActiveWorkbook.RunAutoMacros xlAutoOpen


 Close メソッドを Workbook オブジェクトに指定した場合は、Workbookを閉じます。

expression.Close(SaveChanges, Filename, RouteWorkbook)

 expression 必ず指定します。上のいずれかのオブジェクトを返すオブジェクト式を指定します。

 SaveChanges 省略可能です。バリアント型 (Variant) の値を使用します。
ウィンドウ内のブックに変更がないとき、およびブックに変更があり、同じブックがほかのウィンドウでも表示されているとき、この引数は無視されます。
ブックに変更があり、同じブックがほかのウィンドウで表示されていないとき、この引数は指定された値に応じて、次に示す動作をします。
動作
Trueブックの変更を保存します。
ブックにファイル名が付けられていない場合は、引数 FileName を使ってファイル名を指定します。
引数 FileName を省略すると、ファイル名の入力を促すダイアログ ボックスが表示されます。
Falseファイルの変更を保存しません。
ファイルを保存するかどうかを確認するダイアログ ボックスを表示しません。
省略変更したファイルを保存するかどうかを確認するダイアログ ボックスを表示します。

 FileName 省略可能です。バリアント型 (Variant) の値を使用します。
指定されたファイル名で、変更したファイルを保存します。

 RouteWorkbook   省略可能です。バリアント型 (Variant) の値を使用します。
ブックを次の宛先に回覧する必要がないとき (回覧先がないか、既に回覧されているとき) は、この引数は無視されます。それ以外のときは、次に示すような処理を行います。
処理
True ブックを次の宛先に送ります。
False ブックを送りません。
省略 ダイアログ ボックスを表示し、ブックを送るかどうかを確認します。

 Visual Basic を使ってブックを閉じると、ブックの Auto_Close マクロは実行されません。
Auto_Close マクロを実行するには、RunAutoMacros メソッドを使います。

 次の使用例は、Book1.xls のブックを閉じます。内容の変更は保存しません。


Workbooks("BOOK1.XLS").Close SaveChanges:=False

 次の使用例は、開かれているすべてのブックを閉じます。開かれているブックの内容が変更されている場合は、確認のメッセージや、変更を保存するためのダイアログ ボックスが表示されます。


Workbooks.Close

この種類の目次に戻る↑ 索引へ↓ トップページに戻る


別解:Dir 関数を使う


 「Excelでお仕事!」の下記によると、「FileSearchオブジェクトがまともに動くのは、「Office2000」〜「Office2003」ということになります。」とあります。
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_130.html

 このため、下記のサイトを参考にさせていただき、Dir 関数を使ったバージョンも作ってみました。

 「知識のよどみ」の
 ファイル検索ツールを作る〜指定フォルダ内のファイルをすべて発見する
http://www.k2.dion.ne.jp/~jan2005/tips/excel1_3.html

 dir関数で、指定フォルダ配下全ファイル検索(飛天伝承[天叢雲])
http://archs.press.ne.jp/blog/?itemid=172

 VBA Dir関数の注意点(かっぺちゃんの航海日誌U)
http://yonaizumi.dip.jp/weblog/cappe/2009/01/vbadir.html

 FileSystemObjectを使う方法も、参照下さい。


Option Explicit

Dim ファイル As Integer
Dim データ(1000, 5) As Variant
Dim 行 As Integer


Sub Excelブックの串刺し集計A()

Dim フォルダパス As String
Dim 列 As Integer
Dim 拡張子 As String

   '画面表示を止めて、処理を高速化
   Application.ScreenUpdating = False
   
   '[ファイルを開く]ダイアログボックスで、ファイルを指定して、パスを取得
   フォルダパス = Application.GetOpenFilename("Excelファイル,*.xls")
   拡張子 = "xls"

   '[ファイルを開く]で「キャンセル」した場合は、処理を終了
   If フォルダパス = "False" Then End
   
   'フォルダパスから、後ろのファイル名の部分を削除して、フォルダ・パスに変更
   フォルダパス = Left(フォルダパス, InStrRev(フォルダパス, "\"))
   '最後の\付き
   
    Call フォルダ内のファイル取得(フォルダパス, 拡張子) '★★★★★ 

   
   ThisWorkbook.Worksheets("sheet1").Activate
   
   For 行 = 1 To ファイル
     For 列 = 1 To 5
       ThisWorkbook.Worksheets("sheet1").Range("A5").Cells(行, 列) = データ(行, 列)
     Next 列
   Next 行
   
   Application.ScreenUpdating = True

End Sub


'★★★★★
Private Sub フォルダ内のファイル取得(フォルダパス As String, 拡張子 As String)

    'Dir 関数を使用して、
    '指定されたフォルダで見つかったExcelブックを開きます。

    Dim ファイル名 As String   'Dirの返り値を一時的に保存
    
    '初期化
    ファイル名 = Dir(フォルダパス & "*." & 拡張子, vbDirectory)
    ファイル = 1
    
    'Excelのシート構成が違ってもエラーで止まらないようにする。
    On Error Resume Next

    'ファイル名をリストアップ
    While ファイル名 <> ""
        
        Workbooks.Open Filename:=ファイル名, ReadOnly:=True

        データ(ファイル, 1) = ActiveWorkbook.Worksheets("売上").Range("A11").Value
        データ(ファイル, 2) = ActiveWorkbook.Worksheets("損益").Range("C2").Value
            
        For 行 = 1 To 3
            データ(ファイル, 行 + 2) _
            = ActiveWorkbook.Worksheets("棚卸資産").Range("CB17").Cells(行 * 8, 1).Value
        Next 行
            
        ActiveWorkbook.Close False
        ファイル = ファイル + 1
            
        ファイル名 = Dir()
    Wend
    
End Sub

 Dir 関数は、指定したパターンやファイル属性と一致するファイルまたはフォルダの名前を表す文字列型 (String) の値を返します。ドライブのボリューム ラベルも取得できます。
 Dir 関数が返すファイル名には「パス」が含まれないため、フルパスからファイル名を抽出する目的でも、使えます。

参考:重複しないファイル名をつける
http://vbaexcel.seesaa.net/article/148415705.html

構文:Dir[(pathname[, attributes])]

 pathname 省略可能です。ファイル名を表す文字列式を指定します。フォルダ名およびドライブ名も含めて指定できます。
 引数 pathname に指定した内容が見つからないときは、長さ 0 の文字列 ("") を返します。

 attributes 省略可能です。取得するファイルが持つ属性の値の合計を表す数式または定数を指定します。省略すると、標準ファイルの属性になります。

 引数 attributes の設定値は次のとおりです。
定数内容
vbNormal0標準ファイル
vbReadOnly1読み取り専用ファイル
vbHidden2隠しファイル
vbSystem4システム ファイル
vbVolume8ボリューム ラベル。この値を指定すると、すべての属性は無効になります。
vbDirectory16フォルダ
 これらの定数は、Visual Basic で定義されています。したがって、実際の数値の代わりにコードで使用することができます。
 Windows の場合、複数のファイルを指定するための "*" (アスタリスク) および "?" (疑問符) のワイルドカード文字を使用できます。

 フォルダ内のすべてのファイルに対して繰り返して処理を実行する場合は、引数を指定せずにDir を実行してください。
 Dir("")

 Dir 関数を最初に呼び出すとき、引数 pathname を指定しないとエラーになります。またファイル属性 (引数 attributes) を指定する場合にも、引数 pathname を指定する必要があります。

 Dir 関数は、引数 pathname と一致する最初のファイル名を返します。
それ以外のファイル名で引数 pathname と一致するファイル名を取得するには、引数を指定せずに再び Dir 関数を呼び出してください。
一致するファイル名がない場合は、Dir 関数は長さ 0 の文字列を返します。
長さ 0 の文字列が返された場合は、次に Dir 関数を呼び出すときに引数 pathname を再び指定しなければなりません。指定しないとエラーが発生します。
現在の引数 pathname と一致するファイル名をすべて取得していなくても、途中で引数 pathname の指定を変更できます。
ただし、Dir 関数を再帰的に呼び出すことはできません。vbDirectory 属性を指定して Dir 関数を続けて呼び出しても、連続する下位レベルのサブフォルダは返しません。

 取得したファイルを整理する必要があるときには、ファイル名を配列に格納して並べ替え (ソート) を行ってください。

 次の例は、Dir 関数を使って、指定したファイルまたはフォルダがあるかどうかを確認します。
Dim MyFile, MyPath, MyName
' "WIN.INI" が存在する場合、そのファイル名を返します(Microsoft Windows の場合)。
MyFile = Dir("C:\WINDOWS\WIN.INI")    

' 指定した拡張子を持つファイル名を返します。複数の *.INI ファイル
' が存在すると、最初に見つかったファイル名を返します。
MyFile = Dir("C:\WINDOWS\*.INI")

' 引数を指定せずに再度 Dir 関数を呼び出すと、
' 同じフォルダにある次の *.INIファイルを返します。
MyFile = Dir

' 隠しファイル属性を持つ *.TXT ファイルであり、最初に見つかったファイル名を返します。
MyFile = Dir("*.TXT", vbHidden)

' C:\ 内のフォルダの名前を表示します。
MyPath = "c:\"    ' パスを設定します。
MyName = Dir(MyPath, vbDirectory)    ' 最初のフォルダ名を返します。
Do While MyName <> ""    ' ループを開始します。
    ' 現在のフォルダと親フォルダは無視します。
    If MyName <> "." And MyName <> ".." Then
        ' ビット単位の比較を行い、MyName がフォルダかどうかを調べます。
        If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
            Debug.Print MyName        ' フォルダであれば、それを表示します。
        End If
    End If
    MyName = Dir                    ' 次のフォルダ名を返します。
Loop

この種類の目次に戻る↑ 索引へ↓ トップページに戻る


サブ・フォルダを含めて、フォルダ毎のファイル数をカウント

 Excelマクロファイルを保存したフォルダについて、ファイル数をカウントします。
 サンプルデータは、マクロで削除するので、調べたいフォルダに登録してスタート・ボタンを押すだけで使えます。

 参考にさせて頂いたサイト
ファイルを検索する http://officetanaka.net/excel/vba/tips/tips36.htm

このマクロをダウンロードできます。→CountFilesPerFolderVBA01.xls

Option Explicit
Option Base 1

Dim ファイルシステムオブジェクト As Object
Dim フォルダ_オブジェクト As Object
Dim サブフォルダ As Variant
Dim フォルダパス As Variant

Dim 開始日時 As Variant
Dim 終了日時 As Variant

Dim データ(10000, 2) As Variant 'フォルダパス、ファイル数
Dim このExcelが登録されているフォルダパス As String
Dim フォルダ数 As Integer


Sub サブフォルダを含めてファイル数を取得()
   Dim 最終行 As Integer

   開始日時 = Now                ' 開始時刻を変数に格納します。

   ThisWorkbook.Worksheets("Sheet1").Activate
    
'   シートの過去データを削除
   最終行 = Worksheets("Sheet1").UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
   
   If 最終行 > 10 Then
      Rows("11:" & CStr(最終行)).Delete Shift:=xlUp
   End If
   
   このExcelが登録されているフォルダパス = ThisWorkbook.Path
   
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   
   フォルダパス = ファイルシステムオブジェクト.GetFolder(このExcelが登録されているフォルダパス)

   フォルダ数 = 0

   Call フォルダ直下のファイル数を取得(フォルダパス)
   
   ThisWorkbook.Worksheets("Sheet1").Range("A11").Resize(フォルダ数, 2) = データ

   終了日時 = Now
   MsgBox "処理を終了しました。" & vbNewLine & "処理時間は、" _
   & Format(終了日時 - 開始日時, "nn分ss秒") & " でした。"

End Sub


Private Sub フォルダ直下のファイル数を取得(フォルダパス)

   フォルダ数 = フォルダ数 + 1

   データ(フォルダ数, 1) = フォルダパス '一列目にフォルダ・パスを格納
   データ(フォルダ数, 2) = ファイルシステムオブジェクト.GetFolder(フォルダパス).Files.Count
      
   Set フォルダ_オブジェクト = ファイルシステムオブジェクト.GetFolder(フォルダパス)

   For Each サブフォルダ In フォルダ_オブジェクト.SubFolders
      'フォルダ直下のすべてのフォルダを対象に
      Debug.Print サブフォルダ.Path
      'サブフォルダを使って、再帰呼び出しする
      Call フォルダ直下のファイル数を取得(サブフォルダ.Path)
   Next
   
End Sub


この種類の目次に戻る↑ 索引へ↓ トップページに戻る


ホームページのトップに戻る