Option Explicit

' 参照設定：Microsoft Scripting Runtime
Private Const BeforeMoveFolderPath As String = "C:\works\vba\MoveFolders\Before"
Private Const AfterMoveFolderPath As String = "C:\works\vba\MoveFolders\After"

Private Sub UserForm_Initialize()
    
    ' リストビューの初期化
    Call InitializeTable(ListViewBefore)
    Call InitializeTable(ListViewAfter)
    
    Dim c As Collection
    Call UpdateBeforeViewList
    Call UpdateAfterViewList
End Sub

' リストビューを初期化する
Private Sub InitializeTable(lv As listView)
    
    ' テーブル定義
    With lv
        .View = lvwReport           ' 表示形式　　: ヘッダーありリスト
        .HideSelection = False      ' 選択状態　　: 維持
        .AllowColumnReorder = True  ' セル幅変更　：可
        .FullRowSelect = True       ' 選択範囲　　：行全体
        .Gridlines = True           ' グリッド表示：あり
        .CheckBoxes = True          ' チェック表示：あり
        .LabelEdit = lvwManual      ' ラベル編集　：不可
    End With
    
    ' ヘッダー定義
    With lv
        .ColumnHeaders.Add , "IsMove", "移動対象", 60
        .ColumnHeaders.Add , "FolderName", "フォルダ名", 280
    End With
End Sub

' リストビューを更新する
Private Sub UpdateBeforeViewList()
    Dim lv As listView
    Dim c As Collection
    
    Set lv = ListViewBefore
    Set c = FileUtil.GetSubFolderNameList(BeforeMoveFolderPath)
    With lv.ListItems
        .Clear
        Dim item As Variant
        For Each item In c
            With .Add
                .Text = ""
                .SubItems(1) = item
            End With
        Next
    End With
End Sub

' リストビューを更新する
Private Sub UpdateAfterViewList()
    Dim lv As listView
    Dim c As Collection
    
    Set lv = ListViewAfter
    Set c = FileUtil.GetSubFolderNameList(AfterMoveFolderPath)
    With lv.ListItems
        .Clear
        Dim item As Variant
        For Each item In c
            With .Add
                .Text = ""
                .SubItems(1) = item
            End With
        Next
    End With
End Sub

' イベント
Private Sub ListViewBefore_ItemClick(ByVal item As MSComctlLib.ListItem)
    If (item.Checked) Then
        item.Checked = False
    Else
        item.Checked = True
    End If
End Sub

' ボタンクリック時
Private Sub UpdateFolderButton_Click()
    Call UpdateBeforeViewList
End Sub

' 移動ボタンクリック時
Private Sub MoveFolderButton_Click()
    Dim c As Collection
    Dim i As Long
    Dim message As String
    
    Set c = New Collection
    
    ' 移動対象を追加する
    With ListViewBefore.ListItems
        For i = 1 To .Count
            If (.item(i).Checked = True) Then
                Call c.Add(.item(i).SubItems(1))
                message = message & .item(i).SubItems(1) & vbCrLf
            End If
        Next
    End With
    
    If (c.Count = 0) Then
        MsgBox ("フォルダが選択されていません。処理を中断します。")
        Exit Sub
    End If
    Dim is_exec
    is_exec = MsgBox("以下のフォルダを移動します。よろしいですか。" & vbCrLf & message, vbYesNo, "実行確認")
    If (is_exec = vbNo) Then
        MsgBox ("処理を中断します")
        Exit Sub
    End If
    
    ' フォルダ移動
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    For i = 1 To c.Count
        ' 存在チェック
        Call fso.MoveFolder( _
            BeforeMoveFolderPath & "\" & c.item(i) _
            , AfterMoveFolderPath & "\" & c.item(i) _
        )
    Next
    Set fso = Nothing
    
    MsgBox ("処理が完了しました")
    
    Call UpdateBeforeViewList
    Call UpdateAfterViewList
End Sub

Option Explicit

' 指定フォルダ直下のフォルダ名の一覧を取得する
Public Function GetSubFolderNameList(parent_folder_path As String) As Collection
    Dim fso As FileSystemObject
    Dim c As Collection
    Set fso = New FileSystemObject
    Set c = New Collection
    
    Dim folder As folder
    Set folder = fso.GetFolder(parent_folder_path)
    Dim f As folder
    For Each f In folder.SubFolders
        c.Add (f.Name)
    Next
    Set fso = Nothing
    Set GetSubFolderNameList = c
End Function

' 指定フォルダ直下のファイル名の一覧を取得する
Public Function GetSubFileNameList(parent_folder_path As String) As Collection
    Dim fso As FileSystemObject
    Dim c As Collection
    Set fso = New FileSystemObject
    Set c = New Collection
    
    Dim folder As folder
    Set folder = fso.GetFolder(parent_folder_path)
    Dim f As File
    For Each f In folder.Files
        c.Add (f.Name)
    Next
    Set fso = Nothing
    Set GetSubFileNameList = c
End Function