エクセルＶＢＡでファイルを連続して処理する方法は

Question

エクセルＶＢＡで、エクセルファイルを開いた状態で特定処理を行う仕組みを作りました。
ただ、複数のファイルを処理したいのですが、いちいちファイルを開いてから処理しなければならないため効率が今ひとつです。
ファイル名称をテーブル化するなどして、一気に連続して処理するようにしたいのですが、どのように行えばいいでしょうか。

また、処理したいのは、更新日付が一定日以降のエクセルファイルです。
更新日付と対象ファイルのフォルダーを指定すれば、更新日がそれ以降のファイルを検索し、それが順次処理されていくようなＶＢＡをつくりたいと考えています。

部分的にでもよいので、どなたか分かる方、教えてください。
ちなみにエクセルのバージョンは２０００です。
よろしくお願いします。

KenKen_SP · Accepted Answer

> 選択フォルダのサブフォルダをのものも含むようにはできないでしょうか。

再帰処理すればできますよ。

Microsoft Scripting Runtime を参照してから、次のコードを試してみて
下さい。
取り急ぎで書いたので、エラーがあるかもしれませんが。。。

まあ、環境によっては使えませんし、推奨はできないのですが、FileSearch
を使ってもサブフォルダを含めた検索はできます。調べればサンプルはすぐ
でてくると思いますよ。

ご参考までに。

Private mDateFilter As Date

Sub フォルダ内のXLSファイル順次処理()

　　Dim fso　As FileSystemObject
　　Dim sDir As String
　　
　　' // 日付のフィルタ条件設定 例）10日前の 0:00 以降更新のファイルを対象とする場合
　　mDateFilter = DateAdd("d", -10, Date) + TimeValue("00:00:00")

　　' // 対象ファイルのあるフォルダを指定
　　sDir = BrowseForFolder()
　　If Len(sDir) = 0 Then
　　　　Exit Sub
　　End If

　　Set fso = CreateObject("Scripting.FileSystemObject")
　　
　　Dim fld　As Folder
　　Dim iRes As Integer
　　
　　If fso.FolderExists(sDir) Then
　　　　Set fld = fso.GetFolder(sDir)
　　　　iRes = 0
　　　　If fld.SubFolders.Count > 0 Then
　　　　　　iRes = MsgBox("サブフォルダも検索しますか？", _
　　　　　　　　　　　　　vbYesNoCancel Or vbInformation)
　　　　End If
　　　　Select Case iRes
　　　　　　Case vbYes:　 Call FindFiles(fld, True)
　　　　　　Case vbNo, 0: Call FindFiles(fld, False)
　　　　　　Case Else:　　' // User Cancel
　　　　End Select
　　End If
　　
　　Set fld = Nothing
　　Set fso = Nothing


End Sub

' // XLS ファイルを検索するサブプロシージャ
Private Sub FindFiles( _
　　ByRef fld As Folder, _
　　ByVal fCheckSubfolders As Boolean _
)

　　' // ファイルへの処理
　　Dim f　　　As Object
　　For Each f In fld.Files
　　　　If f.Name Like "*.xls" And f.Name <> ThisWorkbook.Name Then
　　　　　　If f.DateLastModified >= mDateFilter Then
　　　　　　　　' // 処理例
　　　　　　　　Call MainProc(f)
　　　　　　End If
　　　　End If
　　Next

　　' // サブフォルダ検索オプション
　　Dim subFolder As folder
　　If fCheckSubfolders Then
　　　　' // 再帰呼び出し
　　　　For Each subFolder In fld.SubFolders
　　　　　　Call FindFiles(subFolder, True)
　　　　Next
　　End If

End Sub

' // メイン処理 -- FindFiles から順次呼び出されます
Sub MainProc(ByRef f As file)

　　' // ここにご自分で書いたプロシージャを
　　' // とりあえず、セルにでも書き出してみます
　　Dim i As Long
　　i = Cells(Rows.Count, "A").End(xlUp).Row + 1
　　Cells(i, "A").Value = f.Name
　　Cells(i, "B").Value = f.DateLastModified

End Sub

' // フォルダ選択ダイアログ
Private Function BrowseForFolder() As String

　　Const BIF_RETURNONLYFSDIRS = &H1

　　Dim fld As Object
　　Set fld = CreateObject("Shell.Application") _
　　　　　　　.BrowseForFolder(0&, "選択します", BIF_RETURNONLYFSDIRS)
　　If Not fld Is Nothing Then
　　　　BrowseForFolder = fld.Self.Path
　　End If
　　Set fld = Nothing

End Function

mitarashi · Answer

#2・#7です。KenKenSPさんが、親切に書かれているので、当方はさわりだけ解説させていただきます。

>Call searchSubFolder(FSO.GetFolder(folderName))
以上までで、指定フォルダーの下位のフォルダーにあるファイルも含め全てのファイルのリストが出来ています。正確にはリストではなくて、File System Objectの、Fileオブジェクトの集合ですが。
>For i = 1 To fileList.Count
>With fileList(i)
>Debug.Print .Path;
>Debug.Print .DateLastModified
>End With
>Next
ここで、個々のFileオブジェクトにアクセスしています。ここではiで指定していますが、#6の様に、For Eachでアクセスする方法もあります。
#6の下記の部分に相当します。下記での、fld.Filesが、当方のfileListに、fがfileList(i)に相当する訳です。
For Each f In fld.Files
　　　　If f.Name Like "*.xls" And f.Name <> ThisWorkbook.Name Then
　　　　　　If f.DateLastModified >= mDateFilter Then
　　　　　　　　' // 処理例
　　　　　　　　Call MainProc(f)
　　　　　　End If
　　　　End If
　　Next
ご参考まで。

KenKen_SP · Answer

> 「コンパイルエラー　ユーザ定義型は定義されていません」

↓ これが必要です。ちゃんと書いてありますよ。

> Microsoft Scripting Runtime を参照してから

参照設定のことですが、キーワードは提示してますから、知らない
言葉がでてきたら Web 検索なりをして下さい。なるべく専門用語
を使わない文書を心がけていますが、プログラムの世界においては
全てを解説することは不可能です。

> 次処理されていくようなＶＢＡをつくりたいと考えています。

アーリーバインド（参照設定しておくこと）に切り替えたのは、
これまでの質問者・回答者のやり取りの流れからみて、ご質問主に
とって FileSystemObject について理解の手助けになり、また改造
するとき少しでも容易になるようにと考えてのことです。

　　※ コーディング時に入力候補がでてくる
　　　　fso. まで入力すると次につづく候補がポップアップ
　　　　されます。
　　　　つまり、FileSystemObject に関するキーワードの
　　　　リストが得られます。

せっかくの機会ですから、全てを頼らず、ご自分で調べることを
して、理解を深めて下さい。

mitarashi · Answer

#2です。
平日は夜しかアクセスできないので、対応が遅れて済みません。皆さん、バグ修正ありがとうございます。
照れ隠しに、再帰版を作成していたら、またまたKenKenSPさんに先を越されてしまいましたが、参照設定不要版です。検索していません、総当たりです。当方の7500位ファイルがあるフォルダーで、ファイルリスト取得自体は数秒（遅いCeleron）ですが、Debug.Printの方で時間がかかっています。
Dim fileList As Collection
Dim FSO As Object

Sub searchFolder()
    Dim folderName As String
    Dim i As Long

    folderName = "C:\Documents and Settings\?????\My Documents"

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fileList = New Collection
    Call searchSubFolder(FSO.GetFolder(folderName))
    
    For i = 1 To fileList.Count
        With fileList(i)
            Debug.Print .Path;
            Debug.Print .DateLastModified
        End With
    Next
    Set FSO = Nothing
End Sub

Private Sub searchSubFolder(parentFolder As Object)
    Dim subFolder As Object
    Dim myFile As Object
    
     For Each subFolder In parentFolder.SubFolders
         Call searchSubFolder(subFolder)
    Next subFolder
        
    For Each myFile In parentFolder.Files
        fileList.Add Item:=myFile
    Next myFile
    Set parentFolder = Nothing
End Sub

参考URL：http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_080.html

fujillin · Answer

#2と同じですが・・・

指定フォルダ(fp)と比較する日付（d_day)から対象とするエクセルファイルを選別しています。
'***～'***の間に、対象ファイルへの処理（ワークブックオープンから保存までの一連の処理）を記載すれば、連続して処理できます。
下の例では、現在開いているシートにファイル名と更新日付のリストをのA1から順に記入しています。実際には、そのかわりに処理内容を記述しておけばリストを作成する必要はなくなります。
（エクセル2007から拡張子が変わったようですが、2000とのことなのでOKでしょう）

Sub test()
  Dim fs, fl, f, i
  fp = "D:\data\5 WEBツール\TESTrandom"     '←対象とするフォルダのパス
  d_day = #7/30/2008#                       '←比較する日付
  i = 1

  Set fs = CreateObject("Scripting.FileSystemObject")
  Set fl = fs.GetFolder(fp)
  For Each f In fl.Files
　　If (fs.GetExtensionName(f.Path) = "xls") And _
　　　　　(f.DateLastModified >= d_day) Then
'***エクセルファイルに対する処理を記載する
　　　　Cells(i, 1).Value = f.Name
　　　　Cells(i, 2).Value = Format(f.DateLastModified, "yyyy/mm/dd")
　　　　i = i + 1
'***　ここまで
　　End If
　Next
　fs = Null
　fl = Null
End Sub

KenKen_SP · Answer

#3 です。ほとんど #2 ご回答のままですが、一例です。

※ 部において f.Path でフルパスが得られますから、

　　Set wb = Workbooks.Open(f.Path)

などとしてブックを開き、後はご自分で書いたコードを呼び出す
なりして下さい。

Sub Sample()

　　Dim sDir　　　As String
　　Dim dtmFilter As Date

　　' // フィルタリング条件 例）本日より10日前の 0:00 以降
　　dtmFilter = DateAdd("d", -10, Date) + TimeValue("00:00:00")

　　' // 対象ファイルのあるフォルダを指定
　　sDir = BrowseForFolder()
　　If Len(sDir) = 0 Then
　　　　Exit Sub
　　End If

　　' // フォルダ内のファイル順次処理
　　Dim fso　　As Object ' FileSystemObject
　　Dim f　　　As Object ' File
　　Dim i　　　As Long

　　Set fso = CreateObject("Scripting.FileSystemObject")

　　i = 1
　　If fso.FolderExists(sDir) Then
　　　　For Each f In fso.GetFolder(sDir).Files
　　　　　　' // ファイル名でフィルタ
　　　　　　If f.Name Like "*.xls" And f.Name <> ThisWorkbook.Name Then
　　　　　　　　' // 更新日付けでフィルタ
　　　　　　　　If f.DateLastModified >= dtmFilter Then
　　　　　　　　　　' // 処理例　------------------------※
　　　　　　　　　　Cells(i, "A").Value = f.Path
　　　　　　　　　　i = i + 1
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　End If

　　Set fso = Nothing

End Sub

' // フォルダ選択ダイアログ
Private Function BrowseForFolder() As String

　　Const BIF_RETURNONLYFSDIRS = &H1

　　Dim fld As Object
　　Set fld = CreateObject("Shell.Application") _
　　　　　　　.BrowseForFolder(0&, "選択します", BIF_RETURNONLYFSDIRS)
　　If Not fld Is Nothing Then
　　　　BrowseForFolder = fld.Self.Path
　　End If
　　Set fld = Nothing

End Function

KenKen_SP · Answer

こんにちは。横レス失礼します。

> For Each myFile In fileList

Files コレクションの For Each ループですから、

> modifiedDate = FSO.GetFile(myFile.Name).DateLastModified
　　　↓
　modifiedDate = myFile.DateLastModified

と書いた方が良いと思います。

エラーの原因ですけども、FileSystemObject の

　　・Name で得られるもの　　例）test.xls
　　・Path で得られるもの　　例）C:\sample	est.xls

という点を押さえてください。Name で GetFile した場合は、
フルパスではありませんから、カレントフォルダなどでないと

> 実行時エラー’５３’　ファイルが見つかりません

となりますよね。修正すれば、

　modifiedDate = FSO.GetFile(myFile.Path).DateLastModified

となります。

mitarashi · Answer

あるフォルダー中の全ファイルの更新日を取得して、シリアル値に変換するのを試しにやってみました。これだと、検索では無くて、総当たりで拡張子と、更新日付を調べる事になるので、フォルダー中に多量のファイルがあると時間がかかって不適当かも。ご参考まで。
Sub test()
    Dim FSO
    Dim fileList As Object
    Dim myFile As Object
    Dim modifiedDate As String
    Dim modifiedDateSerial As Double
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fileList = FSO.GetFolder("C:\Documents and Settings\?????\My Documents").Files
    For Each myFile In fileList
        Debug.Print FSO.GetExtensionName(myFile)
        modifiedDate = FSO.GetFile(myFile.Name).DateLastModified
        modifiedDateSerial = DateValue(modifiedDate) + TimeValue(modifiedDate)
        Debug.Print Format(modifiedDateSerial, "ggge""年""m""月""d""日""")
    Next
    Set FSO = Nothing
End Sub

参考URL：http://officetanaka.net/excel/vba/filesystemobject/file.htm

M-SOFT#2 · Answer

こんばんは。

開くファイルをリスト化できるのであれば「ファイルを開く」こと自体もマクロで行うようにすればいいと思います。

この場合は、処理を開始するために処理するファイルと別のファイルで処理をするようにすればいいでしょう。

処理用のファイルのシートに開くファイルのリストを作り、そのリストを基に処理を繰り返すようにします。

エクセルＶＢＡでファイルを連続して処理する方法は

> 選択フォルダのサブフォルダをのものも含むようにはできないでしょうか。

この回答への補足

#2・#7です。

> 「コンパイルエラー ユーザ定義型は定義されていません」

この回答への補足

#2です。

この回答への補足

#2と同じですが・・・

この回答への補足

#3 です。

この回答への補足

こんにちは。

あるフォルダー中の全ファイルの更新日を取得して、シリアル値に変換するのを試しにやってみました。

この回答への補足

こんばんは。

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

> 「コンパイルエラー　ユーザ定義型は定義されていません」