用途と仕様
シチュエーションとして、多数の自炊zipファイルがフォルダ毎に格納されているとき、(完)の文字が入ったファイルはあるか?名前順で最後のファイルは何か?を一覧表に出力するExcel VBAのコードです。C:\myData\ZipBooks
┗A
a1.zip, a2.zip, a3.zip
┗B
b1.zip, b2(完).zip
┗C
.........
→a4.zipがまだだよ、ということが知りたい。
VBAのFileSystemObject.FileExistsはワイルドカードが使えないので、Dir関数を使っています。FileSystemObjectはGetFolderからSubFoldersプロパティで全てのサブフォルダが取得できます。名前順で最後のファイルは、ソートを使わず、取得したファイルをFor Eachで回して名前を上書きしていくことで簡易的に探しています。ほとんどの場合、これでうまく動作します(保証はできませんので、厳格なルールがある場合はソート関数を自作する必要があります)。
※VBAの参照設定で「Microsoft Scripting Runtime」にチェックを入れてください。
コード(標準モジュール)
Public Sub zip_search()'任意のフォルダを指定
Const SEARCH_FOLDER = "C:\myData\ZipBooks"
'結果出力する左上のセルを指定
Dim resultRange As Range
Set resultRange = ThisWorkbook.Worksheets(1).Range("A2")
Dim myFso As New FileSystemObject
Dim searchFolder As Folder
Set searchFolder = myFso.GetFolder(SEARCH_FOLDER)
Dim currentFolder As Folder
For Each currentFolder In searchFolder.SubFolders
resultRange.Offset(0, 0).Value = currentFolder.Name
Dim checkCompFile As String
checkCompFile = Dir(currentFolder.Path & "\*完*")
If checkCompFile <> "" Then
resultRange.Offset(0, 1).Value = checkCompFile
resultRange.Offset(0, 2).Value = "complete"
Else
Dim currentFile As File, lastFileName As String
For Each currentFile In currentFolder.Files
lastFileName = currentFile.Name
Next
resultRange.Offset(0, 1).Value = lastFileName
End If
Set resultRange = resultRange.Offset(1, 0)
Next
End Sub
(完)の文字を変えたり、Offsetで出力情報の位置を変えたり、応用してみてください。
0 件のコメント:
コメントを投稿