ドラッグ＆ドロップで指定ファイルを処理し、更にその結果を表示する。

昨日は、ListViewコントロールにファイルをドラッグ＆ドロップすることで、同ファイルのファイルパスを取得する方法を紹介した。
infoment.hatenablog.com
勤め先でも同手法を何度か、幾つかのツールに組み込んで配付したことがある。
すると先日、
「処理状況を見える化できないか？」
というリクエストがあったので、これに挑戦した。

今回はテスト用に、昨日も使用した、↓こちらの記事の残滓を流用する。
infoment.hatenablog.com

今回のテスト用処理要件

1. 処理条件：ファイル名に「パスタ」が含まれるものが対象
2. 処理内容：ファイル名の「パスタ」を「スパゲッティ」に置換

そこでまずユーザーフォームの初期化で、ヘッダーや列の幅などを設定する。

Private Sub UserForm_Initialize()
        With ListView1
            .View = lvwReport
            .LabelEdit = lvwManual
            .HideSelection = False
            .AllowColumnReorder = True
            .FullRowSelect = True
            .Gridlines = True
            
            .ColumnHeaders.Add , "_FileName", "ファイル名", 200
            .ColumnHeaders.Add , "_Result", "処理結果", 100
        End With
End Sub

すると、↓ こうなる。

※ListView1 のWidth は、事前に「300」で設定済み。

次いで、受け取ったファイル毎に名前で判定し、パスタを含むときだけスパゲッティに置換する。

Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    ' Microsoft Scripting Runtime参照済み
    Dim FSO As FileSystemObject
    Set FSO = New FileSystemObject
    
    Dim OldFileName As String
    Dim NewFileName As String
    Dim ParentFolderPath As String
        ParentFolderPath = FSO.GetParentFolderName(Data.Files(1)) & "\"
    
    Dim i As Long
        For i = 1 To Data.Files.Count
            OldFileName = FSO.GetFileName(Data.Files(i))
            With ListView1.ListItems.Add
                .Text = OldFileName
                If OldFileName Like "*パスタ*" Then
                    NewFileName = Replace(OldFileName, "パスタ", "スパゲッティ")
                    Name ParentFolderPath & OldFileName As ParentFolderPath & NewFileName
                    .SubItems(1) = "正常処理終了"
                Else
                    .SubItems(1) = "処理の対象外"
                End If
            End With
        Next
End Sub

早速テストしてみよう。
↓ 処理対象。

↓処理結果。

今回のコード全文は ↓ こちら。

◆ソースコード（クリックで展開）◆

Option Explicit

Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    ' Microsoft Scripting Runtime参照済み
    Dim FSO As FileSystemObject
    Set FSO = New FileSystemObject
    
    Dim OldFileName As String
    Dim NewFileName As String
    Dim ParentFolderPath As String
        ParentFolderPath = FSO.GetParentFolderName(Data.Files(1)) & "\"
    
    Dim i As Long
        For i = 1 To Data.Files.Count
            OldFileName = FSO.GetFileName(Data.Files(i))
            With ListView1.ListItems.Add
                .Text = OldFileName
                If OldFileName Like "*パスタ*" Then
                    NewFileName = Replace(OldFileName, "パスタ", "スパゲッティ")
                    Name ParentFolderPath & OldFileName As ParentFolderPath & NewFileName
                    .SubItems(1) = "正常処理終了"
                Else
                    .SubItems(1) = "処理の対象外"
                End If
            End With
        Next
End Sub

Private Sub UserForm_Initialize()
        With ListView1
            .View = lvwReport
            .LabelEdit = lvwManual
            .HideSelection = False
            .AllowColumnReorder = True
            .FullRowSelect = True
            .Gridlines = True
            
            .ColumnHeaders.Add , "_FileName", "ファイル名", 200
            .ColumnHeaders.Add , "_Result", "処理結果", 100
        End With
End Sub

やっぱり、処理の見える化は重要だなと思った次第です。

参考まで。