/*Google AdSense自動広告*/

2019年1月31日木曜日

Excel VBA FileSystemObjectとDir関数を使用して、サブフォルダ内の自炊zipファイルの(完)判定と最終巻ファイル名の一覧を出力する

用途と仕様

シチュエーションとして、多数の自炊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 件のコメント:

コメントを投稿