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

質問

エクセルＶＢＡで、エクセルファイルを開いた状態で特定処理を行う仕組みを作りました。
ただ、複数のファイルを処理したいのですが、いちいちファイルを開いてから処理しなければならないため効率が今ひとつです。
ファイル名称をテーブル化するなどして、一気に連続して処理するようにしたいのですが、どのように行えばいいでしょうか。

また、処理したいのは、更新日付が一定日以降のエクセルファイルです。
更新日付と対象ファイルのフォルダーを指定すれば、更新日がそれ以降のファイルを検索し、それが順次処理されていくようなＶＢＡをつくりたいと考えています。

部分的にでもよいので、どなたか分かる方、教えてください。
ちなみにエクセルのバージョンは２０００です。
よろしくお願いします。

回答No.6

KenKen_SP · ベストアンサー

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

再帰処理すればできますよ。

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

お礼

ご回答ありがとうございました。

>Microsoft Scripting Runtime を参照してから、次のコードを試してみて
>下さい。

「参照設定」でMicrosoft Scripting Runtimeをチェックすることで、
動作することができました。

勉強不足ですみませんでした。
すばらしいプログラムを大変ありがとうございました。

補足

ご回答本当にありがとうございます。

ただ実行してみたのですが、
Private Sub FindFiles( _
ByRef fld As folder, _
ByVal fCheckSubfolders As Boolean _
)
のところで、「コンパイルエラー　ユーザ定義型は定義されていません」
とメッセージが出て、止まってしまいました。
知識不足で、よくわかりません。

本当に度々すみません。
先ほどのまではきちんと動いていたのですが。。。

回答No.9

mitarashi

#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
ご参考まで。

お礼

ご回答ありがとうございました。

KenKenSPさんが提供してくださったプログラムが動かせるようになりました。
「参照設定」というものがわかっていませんでした。。。

上記のご回答大変ありがとうございます。
ひとつひとつ確認してみます。

長らくご面倒をおかけし、すみませんでした。
解決できて本当に助かりました。

回答No.8

KenKen_SP

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

↓ これが必要です。ちゃんと書いてありますよ。

> Microsoft Scripting Runtime を参照してから

参照設定のことですが、キーワードは提示してますから、知らない
言葉がでてきたら Web 検索なりをして下さい。なるべく専門用語
を使わない文書を心がけていますが、プログラムの世界においては
全てを解説することは不可能です。

> 次処理されていくようなＶＢＡをつくりたいと考えています。

アーリーバインド（参照設定しておくこと）に切り替えたのは、
これまでの質問者・回答者のやり取りの流れからみて、ご質問主に
とって FileSystemObject について理解の手助けになり、また改造
するとき少しでも容易になるようにと考えてのことです。

　　※ コーディング時に入力候補がでてくる
　　　　fso. まで入力すると次につづく候補がポップアップ
　　　　されます。
　　　　つまり、FileSystemObject に関するキーワードの
　　　　リストが得られます。

せっかくの機会ですから、全てを頼らず、ご自分で調べることを
して、理解を深めて下さい。

お礼

本当にいろいろありがとうございました。

やっとわかりました。
「参照設定」というところで、「Microsoft Scripting Runtime」を
チェックすればいいんですね。

これで、きちんと動きました！
すみません。動かないときは何かパニックになってしまっていました。

ありがとうございました。助かりました。

補足

ご回答ありがとうございます。

>↓ これが必要です。ちゃんと書いてありますよ。

>> Microsoft Scripting Runtime を参照してから

すみません。「Microsoft Scripting Runtime」はＧＯＯＧＬＥで
検索してみたのですが、わけがわからなかったので、とりあえず動かしてみました。

>せっかくの機会ですから、全てを頼らず、ご自分で調べることを
>して、理解を深めて下さい。

仰る通りです。。。反省します。
もう少し勉強してみます。

回答No.7

mitarashi

#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

お礼

ご回答ありがとうございました。

KenKenSPさんが提供してくださったプログラムが動かせるようになりました。
すみません。動かなくなって、どうすることもできなくて、
慌ててしました。
「参照設定」というものがわかっていませんでした。。。
もっと勉強します。
本当にありがとうございました。
助かりました。

補足

本当にみなさんありがとうございます（泣）。
親切が、心に染みます。

でも、もう少しお願いを聞いていただけると。。。

上記のプログラムですが、「更新日付の検索」部分を入れていただき、
「ファイルをオープンする場所（できれば記述も）」と、「私がつくっているファイル単位の処理部分を挿入する場所」を教えていただけると、大変助かります。
これでなんとかなるかも。。。

手がかかってすみません。。。
お願いできますでしょうか。。。

回答No.5

fujillin

#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

お礼

ご回答ありがとうございました。

他の方法でなんとか解決できました。
大変ありがとうござました。

いろいろな方法があることがわかりました。
勉強になりました。

補足

ご回答ありがとうございます。

みなさんに助けていただいて恐縮です。

恐縮ついでで、サブフォルダまで参照できるようになると素晴らしいなあと思います（汗）。
いや、本当に、もし気が向いたらお願いします。。。

とてもシンプルにつくってあって素晴らしいと思います。
本当にありがとうございます！

回答No.4

KenKen_SP

#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

お礼

ご回答大変ありがとうございます。

サブフォルダの参照方法も後で教えていただき大変ありがとうございました。

補足

ご回答大変ありがとうございます。
試してみたら、できているような感じがします。よく確認してみます。
本当に感謝いたします。

ただ、ひとつだけ確認なのですが、フォルダー選択を行った場合、
処理対象のファイルを、選択フォルダのサブフォルダをのものも含むようには
できないでしょうか。
勉強不足ですみません。ご確認のほどお願いします。

回答No.3

KenKen_SP

こんにちは。横レス失礼します。

> For Each myFile In fileList

Files コレクションの For Each ループですから、

> modifiedDate = FSO.GetFile(myFile.Name).DateLastModified
　　　↓
　modifiedDate = myFile.DateLastModified

と書いた方が良いと思います。

エラーの原因ですけども、FileSystemObject の

　　・Name で得られるもの　　例）test.xls
　　・Path で得られるもの　　例）C:\sample\test.xls

という点を押さえてください。Name で GetFile した場合は、
フルパスではありませんから、カレントフォルダなどでないと

> 実行時エラー’５３’　ファイルが見つかりません

となりますよね。修正すれば、

　modifiedDate = FSO.GetFile(myFile.Path).DateLastModified

となります。

お礼

ご回答ありがとうございます。

> 実行時エラー’５３’　ファイルが見つかりません

この問題解決しました。
大変ありがとうございました！！！

回答No.2

mitarashi

あるフォルダー中の全ファイルの更新日を取得して、シリアル値に変換するのを試しにやってみました。これだと、検索では無くて、総当たりで拡張子と、更新日付を調べる事になるので、フォルダー中に多量のファイルがあると時間がかかって不適当かも。ご参考まで。
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

お礼

ご回答ありがとうございました。

「実行時エラー’５３’　ファイルが見つかりません」
の件、後のご回答で解決しました。

ありがとうございました。

補足

ご回答ありがとうございました。

ただ、実行してみたのですが、うまくいかないのです。
基本的な知識がないからだと思います。すみません。

("C:\Documents and Settings\?????\My Documents")
のところは、自分の該当フォルダーに変更しました。
それで実行したところ、
modifiedDate = FSO.GetFile(myFile.Name).DateLastModified
の行で、「実行時エラー’５３’　ファイルが見つかりません」
というメッセージが出て止まってしまいます。
（該当のフォルダには複数のファイルが存在しています。
　エクセルのファイルもあります）いろいろ試してみたのですがわかりませんでした。

すみませんが教えていただけると助かります。お手数ですがよろしくお願いします。

回答No.1

noname#187541

こんばんは。

開くファイルをリスト化できるのであれば「ファイルを開く」こと自体もマクロで行うようにすればいいと思います。

この場合は、処理を開始するために処理するファイルと別のファイルで処理をするようにすればいいでしょう。

処理用のファイルのシートに開くファイルのリストを作り、そのリストを基に処理を繰り返すようにします。

お礼

ご回答ありがとうございました。

後で沢山の人に教えていただきながら、なんとか解決することができました。

あまりにも知識がなくてご迷惑をおかけしすぎて、恐縮です。
でも動いてよかった。

最初にご回答いただき、大変うれしかったです。
ありがとうございました。

補足

ご回答ありがとうございます。

>開くファイルをリスト化できるのであれば「ファイルを開く」こと自体もマクロで行うようにすればいいと思います。

これはなんとなくわかります。

>この場合は、処理を開始するために処理するファイルと別のファイルで処理をするようにすればいいでしょう。

これもわかるような気がします。

>処理用のファイルのシートに開くファイルのリストを作り、そのリストを基に処理を繰り返すようにします。

これってどうやってやるのでしょう？？？
ファイルのリストができたとして、順々に処理するのって結構難しそう。また、リストの終了時にうまく処理から抜けて、処理全体を終了するのってどうやるのでしょう？？？

すみませんが、教えて欲しいです。。。