フォルダコピーとファイルの移動　～ ② 移動先のフォルダ作成～

昨日は、いただいた問い合わせ内容を整理しながら、テスト環境を作成してみた。
infoment.hatenablog.com
今日も、昨日の続きから。

昨日の記事を書いた後、質問された方から幾つか条件の訂正連絡があった。

フォルダの移動先に、フォルダＡは最初からは存在していない。
フォルダＢ１，Ｂ２・・・は、作成したフォルダＡにコピーののち、元を削除したい。
フォルダＢ１，Ｂ２・・・をループで処理したい。

ということで実際は、↓ 雲マークのフォルダＡが存在しない場合は作る、という
修正のみでよさそうだ。

処理条件を眺めてみると、各Ａの中の各Ｂをそれぞれ確認する必要があるので、
二重ループになりそうだ。

こんなとき、様々なアプローチがあると思うが、今回まず小さな範囲で処理を
作り、それをループさせる方式でやってみる。

ということで、「C:\Temp\コピー元\Ａ\Ｂ1\20220701」を、コピー先に移動
させてみよう。

フォルダパスから、「Ａ」というフォルダ名を取得する。
取得した名称から、「C:\Temp\コピー元\Ａ」というパスを作成する。
作成したフォルダパスが存在するか確認。存在しない場合は作成する。
作成した先に、「Ｂ1」を移動させる。

Sub Test()
    ' 階層Ａのフォルダ名。
    Dim FolderA As String
        FolderA = "Ａ"

    ' 階層Ｂのフォルダ名。
    Dim FolderB As String
        FolderB = "Ｂ1"
        
    ' 移動する部分のフォルダパス。
    Dim MovePartName As String
        MovePartName = "Ａ\Ｂ1"

    ' 移動元のパス。
    Dim SrcFolderPath As String
        SrcFolderPath = FSO.BuildPath(SrcParentFolderPath, MovePartName)
    
    ' 移動先のパス。
    Dim DstFolderPath As String
        DstFolderPath = FSO.BuildPath(DstParentFolderPath, MovePartName)
    
    ' 階層Ａの移動先フォルダパス。
    Dim DstFolderAPath As String
        DstFolderAPath = FSO.BuildPath(DstParentFolderPath, FolderA)
    
    ' 移動先のフォルダ有無確認｡なければ作成する｡
        If Not FSO.FolderExists(DstFolderAPath) Then
            MkDir DstFolderAPath
        End If
    
    ' フォルダ移動。
        FSO.MoveFolder SrcFolderPath, DstFolderPath
End Sub

実行してみると、コピー先にフォルダＡが作成され、その下にＢ１以降の
フォルダおよびファイルが全て移動していることが分かる。

実際はループでの処理となるので、FolderAおよびBは引数として与えた
方がよさそうだ。

Sub MoveTargetFolder(folder_a As String, folder_b As String)
    ' 移動する部分のフォルダパス。
    Dim MovePartName As String
        MovePartName = folder_a & "\" & folder_b

    ' 移動元のパス。
    Dim SrcFolderPath As String
        SrcFolderPath = FSO.BuildPath(SrcParentFolderPath, MovePartName)
    
    ' 移動先のパス。
    Dim DstFolderPath As String
        DstFolderPath = FSO.BuildPath(DstParentFolderPath, MovePartName)
    
    ' 階層Ａの移動先フォルダパス。
    Dim DstFolderAPath As String
        DstFolderAPath = FSO.BuildPath(DstParentFolderPath, folder_a)
    
    ' 移動先のフォルダ有無確認｡なければ作成する｡
        If Not FSO.FolderExists(DstFolderAPath) Then
            MkDir DstFolderAPath
        End If
    
    ' フォルダ移動。
        FSO.MoveFolder SrcFolderPath, DstFolderPath
End Sub

↓ こちらでテストしたところ、先程と同じ結果を得ることができた。

Sub test()
    MoveTargetFolder "Ａ", "Ｂ1"
End Sub

次回はこれを、ループに組み込みます。

参考まで。