ディレクトリの最下位階層にあるPDFデータを一つのフォルダにまとめる方法を教えてください。


現在は以下のように、第1ディレクトリの中に第2ディレクトリが50個くらいあり、第2ディレクトリの中に第3ディレクトリがそれぞれ10個くらいあり、第3ディレクトリの中にPDFデータがそれぞれ10個くらいあります。

PDFデータは全部で5000個くらいあるのですが、これを一つのフォルダにまとめることが出来る方法を教えてください。
その際にPDFデータに、第1ディレクトリから第3ディレクトリまでのフォルダ名を付加させられるとなおベターです。

よろしくお願い致します。

第1階層ディレクトリ
---第2階層ディレクトリ
------第3階層ディレクトリ
---------※※.pdf
---------※※.pdf
------第3階層ディレクトリ
---------※※.pdf

これを

ディレクトリ
---第1階層ディレクトリ名_第2階層ディレクトリ名_第3階層ディレクトリ名_※※.pdf
---第1階層ディレクトリ名_第2階層ディレクトリ名_第3階層ディレクトリ名_※※.pdf
---第1階層ディレクトリ名_第2階層ディレクトリ名_第3階層ディレクトリ名_※※.pdf

↑のようにしたいです。

回答の条件
  • 1人2回まで
  • 登録:2009/03/11 19:12:12
  • 終了:2009/03/11 21:04:45

ベストアンサー

id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692009/03/11 20:54:04

ポイント90pt

ファイル管理ソフトで使えそうなものが見つからなかったので、Excelのマクロでファイル移動のコードを書いてみました。

最初の第一フォルダと保存先のパスを変えて実行してみてください。

安全の為に、移動ではなくコピーにしています。


Option Explicit

Sub macroCopy()
    '第一フォルダのパスを指定してください
    Const dataPath As String = "C:\Documents and Settings\hogehoge\デスクトップ\第一"
    '保存先のフォルダのパスを指定してください
    Const savePath As String = "C:\Documents and Settings\hogehoge\デスクトップ\save"
    
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim fold1
    Dim fold2
    Dim fold3
    Dim fil
    
    Set fold1 = FSO.GetFolder(dataPath)
    
    For Each fold2 In fold1.SubFolders
        For Each fold3 In fold2.SubFolders
            For Each fil In fold3.Files
                If StrConv(Right(fil.Name, 4), vbLowerCase) = ".pdf" Then
                    FSO.CopyFile fil.Path, savePath & "\" & fold1.Name & "_" _
                    & fold2.Name & "_" & fold3.Name & "_" & fil.Name
                End If
            Next
        Next
    Next
    
    Set fold3 = Nothing
    Set fold2 = Nothing
    Set fold1 = Nothing
    Set FSO = Nothing
End Sub
id:ion10

ありがとうございます!!!!

完璧に出来ました!!!!

2009/03/11 21:03:54

その他の回答(1件)

id:seble No.1

seble回答回数4680ベストアンサー獲得回数6172009/03/11 20:12:14

ポイント35pt

http://www.55555.to/what/gm.htm

極窓

拡張子変換フリーソフトですが、ご要望のような事も簡単にできます。

(5千個もあるとちょっと考えるかもしれませんが、、)

特定のフォルダ(階層下全てを含む事も可能)内で拡張子やファイル名の一部をもって検索し、別の特定のフォルダへ一括移動可能です。

フォルダ名を自動で付けるのは無理ですが、、、

また、同一のファイル名を同一のフォルダへ置けませんので

(まあ、どこでも普通はそうだな)

もし、ある場合は上書きか、移動しないかどちらかをいちいち選択する事になります。

リネームソフトであるので、先にファイル名の変更をしておく事は簡単ですが、、

フォルダ毎に連番でも付けてやればよろしいかと、、

id:ion10

ありがとうございます。

同一ファイル名が多々ありますので、先にファイル名の変更をする必要がありますが、500フォルダでそれぞれ変更しなければならないのは大変です。。。

2009/03/11 20:17:50
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692009/03/11 20:54:04ここでベストアンサー

ポイント90pt

ファイル管理ソフトで使えそうなものが見つからなかったので、Excelのマクロでファイル移動のコードを書いてみました。

最初の第一フォルダと保存先のパスを変えて実行してみてください。

安全の為に、移動ではなくコピーにしています。


Option Explicit

Sub macroCopy()
    '第一フォルダのパスを指定してください
    Const dataPath As String = "C:\Documents and Settings\hogehoge\デスクトップ\第一"
    '保存先のフォルダのパスを指定してください
    Const savePath As String = "C:\Documents and Settings\hogehoge\デスクトップ\save"
    
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim fold1
    Dim fold2
    Dim fold3
    Dim fil
    
    Set fold1 = FSO.GetFolder(dataPath)
    
    For Each fold2 In fold1.SubFolders
        For Each fold3 In fold2.SubFolders
            For Each fil In fold3.Files
                If StrConv(Right(fil.Name, 4), vbLowerCase) = ".pdf" Then
                    FSO.CopyFile fil.Path, savePath & "\" & fold1.Name & "_" _
                    & fold2.Name & "_" & fold3.Name & "_" & fil.Name
                End If
            Next
        Next
    Next
    
    Set fold3 = Nothing
    Set fold2 = Nothing
    Set fold1 = Nothing
    Set FSO = Nothing
End Sub
id:ion10

ありがとうございます!!!!

完璧に出来ました!!!!

2009/03/11 21:03:54

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません