フォルダ内pdfファイルの移動

Question

実現したいこと

親フォルダ内の子フォルダと同じ階層にいるpdfファイルを、子フォルダと同じ階層にいる完了フォルダへ移動したいです。
●イメージ図

●作業流れ
①ツール.xlsmからVBA実行
②子フォルダ内のpdfファイルを完了フォルダへ移動

●全体フォルダ構成

※ツール一覧フォルダ内にツール.xlsmが格納されています。
※テスト環境内にイメージ図の親、子フォルダ、pdfファイルが格納されています。

前提

・pdfファイルがない場合は、処理をスルーしたい。
・親フォルダは今後100フォルダになると想定しております。
それにともなって親フォルダの名称は新規作成される時でないと分からないようになっています。

発生している問題・エラーメッセージ・調査したこと・試したこと

・移動前と移動先のフォルダパスが変化する為、変化に対応したパス指定の方法が分かりませんでした。

該当のソースコード

Sub 完了フォルダへpdfファイル移動()
'複数のファイルを移動する
    Dim FSO As New FileSystemObject
    Dim FromPath As String
    Dim ToPath As String
    Dim FileInFromFolder As Object

    FromPath = "C:\Users\z09071\Desktop\一時\テスト環境\"
    ToPath = "C:\Users\z09071\Desktop\一時\テスト環境\\"
   
    Set FSO = CreateObject("Scripting.FileSystemObject")

    For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
        FileInFromFolder.Move ToPath
    Next FileInFromFolder

End Sub

Comments

[logres_Fan]

ファイル管理ソフトやgitを使わないの？

[jabe]

返信ありがとうございます。
今回は、VBAで実施したいと考えております。

[logres_Fan]

了解です。チャレンジするなら、WordのVBAで実施すると凄いと思います。頑張って下さい。

[meg_]

> 移動前と移動先のフォルダパスが変化する為、変化に対応したパス指定の方法が分かりませんでした。
フォルダ名が変化しない前提であればやりたい事が実現できている、と理解して良いですか？

[jabe]

返信ありがとうございます。
はい、From、ToPath変数へ固定のパスを指定する方法により、固定フォルダ名間の移動は出来るようになっているのですが、今回はフォルダ名が変化するため狙った動作ができない状態になります。

[meg_]

> ・pdfファイルがない場合は、処理をスルーしたい。
上記についても実装済ですか？

[jabe]

返信ありがとうございます。
私のコードでは実装できておりません。

Answer 1

以下のようにしてください。
注意事項
１．拡張子が.pdfのファイルのみ転送します。
２．必ず、"完了"フォルダが存在する前提です。（"完了"フォルダがないとエラーになります）
３．移動先に同じファイル名のファイルがない前提です。（同じファイル名のファイルがあるとエラーになります）

Sub 完了フォルダへpdfファイル移動()
'複数のファイルを移動する
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim Folder As Object
    Dim File As Object
    FromPath = "C:\Users\z09071\Desktop\一時\テスト環境\"
   
    Set FSO = CreateObject("Scripting.FileSystemObject")

    For Each Folder In FSO.GetFolder(FromPath).subfolders
        For Each File In Folder.Files
            If LCase(Right(File.Name, 4)) = ".pdf" Then
                ToPath = Folder.Path & "\完了\" & File.Name
                File.Move (ToPath)
            End If
        Next
    Next
    MsgBox ("完了")
End Sub

Comments

[jabe]

コード作成ありがとうございます。
試したところ、私のイメージ通りに動作できました。
本当にありがとうございました。