ListView にファイルをドラッグ&ドロップして登録する (その2)実ファイルを指定フォルダにコピー・削除

最終更新: 3月23日


今回は、その1で試したリストビューの機能を拡張してみます。

例として、下図のように工事の基本情報に図面や契約書などの関係書類を紐づけて管理する用途を想定しています。

<追加機能>

1. ユーザーフォームを起動時に、指定フォルダ内のファイル一覧をリストビューに表示する。

2. リストビューにファイルをドラッグ&ドロップした際に、指定フォルダにコピーして保存する。

3. リストビューからファイルを削除した際に、指定フォルダからもファイルを削除する。

<コントロール>

lblDestinationFolder : ファイルの保存先フォルダを示すラベル cmdOpenFolder : フォルダを開くためのボタン

cmdDelete: 選択したファイルを削除するボタン

下準備として、ファイルを保存するフォルダを任意の場所に作ってください。

ここでは、C:\Users\user\Desktop\佐藤邸リフォーム工事 としています。

それから、適当なファイルをいくつかその保存フォルダに入れておいて下さい。

1. ユーザーフォームを起動時に、指定フォルダ内のファイル一覧をリストビューに表示する。

保存フォルダのパスを定数としてユーザーフォーム1のコードの一番上にでも入れておいて下さい。

Const destinationFolder As String = "C:\Users\user\Desktop\佐藤邸リフォーム工事"

次に、ユーザーフォーム1の初期化イベントに、保存フォルダ内のファイル一覧をリストビューに表示します。

<処理の流れ>

1. Dir([Path] & "\") で、保存フォルダに入っているファイルのうち、一番先頭のファイル名を取得します。

2. 取得したファイル名をリストビューに追加します。

3. 次のファイル名を取得します。

4. 最後のファイルまで2,3の処理を繰り返します。


Private Sub UserForm_Initialize()

    With Me.ListView1

        .View = lvwReport           '表示形式

        .LabelEdit = lvwManual      'ラベル編集

        .AllowColumnReorder = True  '列幅の変更を許可

        .FullRowSelect = True     '行全体を選択

        .Gridlines = True           'グリッド

        .MultiSelect = True        '複数選択

        .OLEDragMode = ccOLEDragManual  'ドラッグ

        .OLEDropMode = ccOLEDropManual  'ドロップ

        '列見出し

        .ColumnHeaders.Add , "key1", "File Name", 230, lvwColumnLeft

        .ColumnHeaders.Add , "key2", "File Path", 0, lvwColumnLeft

        .HideColumnHeaders = True

    End With
 
    Dim files As String

    files = Dir(destinationFolder & "\")

    Do While files <> ""

        Me.ListView1.ListItems.Add.Text = files

        files = Dir()

    Loop

End Sub
 

2. リストビューにファイルをドラッグ&ドロップした際に、指定フォルダにコピーして保存する。

ListView1のOLEDragDropイベントに次の処理を追加します。

<処理の流れ>

1. ファイルの保存フォルダを取得します。

2. ファイル名と保存フォルダを¥で結合して、コピー先ファイル名(destinationFileName)を作ります。

3. FileCopy メソッドでコピー (FileCopy [source], [destination])

Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)

    Dim filePath As String

    Dim fileName As String

    Dim fileCount As Long

    Dim indexFile As Long
 

    fileCount = Data.Files.Count 'ドロップするファイルの数を取得

    For indexFile = 1 To fileCount 'ファイルの数だけ処理を繰り返す

        filePath = Data.Files(indexFile) '

        fileName = Dir(filePath)

        With Me.ListView1.ListItems.Add

            .Text = fileName

            .SubItems(1) = filePath
 
            destinationFileName = destinationFolder & "\" & fileName

            FileCopy filePath, destinationFileName
 

        End With

    Next

End Sub

3. リストビューからファイルを削除した際に、指定フォルダからもファイルを削除する。

<処理の流れ>

1. ListView1を一行ずつ検証して、選択されているか否かを判定します。

2. 選択されているファイルをKillメソッドで削除します。

3.保存フォルダ内のファイル一覧をリストビューに表示する。

Private Sub cmdDelete_Click()

    If Me.ListView1.ListItems.Count < 1 Then Exit Sub

    Dim rowIndex As Long

    For rowIndex = 1 To Me.ListView1.ListItems.Count

        If Me.ListView1.ListItems(rowIndex).Selected = True Then

            Kill destinationFolder & "\" & Me.ListView1.ListItems(rowIndex).Text

        End If

    Next
 

    Me.ListView1.ListItems.Clear

    Dim files As String

    Dim fileIndex As Long

    files = Dir(destinationFolder & "\")

    Do While files <> ""

        Me.ListView1.ListItems.Add.Text = files

        files = Dir()

    Loop
End Sub

最後におまけとして、管理画面から保存フォルダをエクスプローラーで開く機能を追加します。簡単ですが非常に有用な機能です。ここではやりませんが、特定のファイルをエクスプローラー内で選択した状態でフォルダを開くこともできます。沢山のファイルの中から特定の見つけ出す手間が省けて便利です。

cmdOpenFolderボタンのクリックイベントに次のコードを書きます。


Private Sub cmdOpenFolder_Click()

   Call Shell("explorer.exe /n," & destinationFolder, vbNormalFocus)

End Sub

これで、保存先フォルダーがエクスプローラーで開かれます。

#ExcelVBA #Listview #ドラッグドロップ