ListView にファイルをドラッグ&ドロップして登録する （その２）実ファイルを指定フォルダにコピー・削除
今回は、その1で試したリストビューの機能を拡張してみます。
例として、下図のように工事の基本情報に図面や契約書などの関係書類を紐づけて管理する用途を想定しています。
＜追加機能＞
1. ユーザーフォームを起動時に、指定フォルダ内のファイル一覧をリストビューに表示する。
2. リストビューにファイルをドラッグ&ドロップした際に、指定フォルダにコピーして保存する。
3. リストビューからファイルを削除した際に、指定フォルダからもファイルを削除する。
＜コントロール＞
lblDestinationFolder : ファイルの保存先フォルダを示すラベル cmdOpenFolder : フォルダを開くためのボタン
cmdDelete: 選択したファイルを削除するボタン
下準備として、ファイルを保存するフォルダを任意の場所に作ってください。
ここでは、C:\Users\user\Desktop\佐藤邸リフォーム工事 としています。
それから、適当なファイルをいくつかその保存フォルダに入れておいて下さい。
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
これで、保存先フォルダーがエクスプローラーで開かれます。
