• 締切済み

エクセルマクロで、フォルダ内のファイル移動をしたい

写真整理フォルダの下に、大項目フォルダがあります。 その中に、月フォルダがありその中に日付フォルダがあります。 その日付フォルダの中に細項目でフォルダ分けされてそれぞの中にjpgファイルが 入っています。 今回は、その細項目で整理されたjpgファイルを日付フォルダの直下へ移動したいのです。 共有フォルダを、指定しようとすると階層が深いのでこのフォルダ内の各日付フォルダに 入っているフォルダの中のjpgファイルを日付フォルダへ移動せよというのが エクセルのマクロで命令出来ればと思っているのですが。 3万件以上を処理しないといけないのでとても困っています。 コードのご教示宜しくお願い致します。

みんなの回答

  • HohoPapa
  • ベストアンサー率65% (455/693)
回答No.4

再帰プロシージャを使うコードとしてみました。 また、 >重複ファイルが、あるかないかと言われると分からないのですが この場合、先勝ちとし、後負けとなったファイルは そのまま残し、ファイル名のフルパスを シートに書き込むようにしてみました。 実際に対象とするフォルダー構造を明示してもらえないので テストしていません。 事前に控えを取得するとか、 十分なテストをしたうえで使ってみてください。 Option Explicit Const EnKazu = 6 '日付フォルダーの深さ(\の数) Const tgDir = "D:\色々\写真集" Dim RowCouunter As Long '// これを起動する=========== Sub FileMoveMain()  RowCouunter = 1  Call FLMove(tgDir) End Sub '// =========== Sub FLMove(Path As String)  Dim buf As String, f As Object  buf = Dir(Path & "\*.*")  Do While buf <> ""   If FileExists(GetOyaDir(Path, EnKazu) & buf) = True Then    RowCouunter = RowCouunter + 1    ThisWorkbook.Sheets(1).Cells(RowCouunter, 1).Value = _     Path & "\" & buf   Else    If GetOyaDir(Path, EnKazu) <> "" Then     Name Path & "\" & buf As GetOyaDir(Path, EnKazu) & buf    End If   End If   buf = Dir()  Loop  With CreateObject("Scripting.FileSystemObject")   For Each f In .GetFolder(Path).SubFolders    Call FLMove(f.Path)   Next f  End With End Sub '// 日付フォルダー名取得関数 Function GetOyaDir(FullDir As String, Kaiso As Long) As String  Dim wkCnter As Long  Dim wkDir As String  Dim wkPos As Long  wkDir = FullDir  wkPos = 1  GetOyaDir = ""  For wkCnter = 1 To Kaiso   wkPos = InStr(wkPos + 1, wkDir, "\")  Next wkCnter  If Len(Left(FullDir, wkPos)) > Len(tgDir) Then   GetOyaDir = Left(FullDir, wkPos)  End If End Function '// ファイル有無判定関数 Function FileExists(ChkFile As String) As Boolean  FileExists = True  On Error GoTo ErrorHandler  FileDateTime (ChkFile)  On Error GoTo 0  Exit Function ErrorHandler:  FileExists = False  Resume Next End Function

  • NuboChan
  • ベストアンサー率47% (785/1650)
回答No.3

階層下のディレクトリー=サブディレクトリーも含めて一括で削除するなら 『rd /s /q ディレクトリ名』を利用します。 以下参照 https://www.k-tanaka.net/cmd/rd.php 移動する場合にファイル名が重複する場合が合ってもファイラーを利用して  同名ファイルがある場合、変名するようにファイラー側で設定すれば問題はありません。

  • HohoPapa
  • ベストアンサー率65% (455/693)
回答No.2

>日付フォルダの中に細項目でフォルダ分けされて 日付フォルダの下階層に複数階層のフォルダーがありますか? >日付フォルダの直下へ移動したいのです ここに集まることでファイル名が重複することはないんでしょうか? また、 後に示すような書き方などでサンプル表示し さらに、どのような結果にしたいのかも説明してほしいところです。 更に、 日付フォルダの直下へ移動することで その下階層に、空のフォルダーが残るわけですが このフォルダーたちは手作業で削除する予定ですね? D:\色々 ┗\写真集  ┗\海   ┗\201801    ┗\01     ┗\東北      ┗\ABC.jpg      ┗\DEF.jpg      ┗\青森       ┗\100.jpg      ┗\秋田       ┗\100.jpg       ┗\200.jpg    ┗\02     ┗\東北      ┗\FGH.jpg      ┗\HIJ.jpg      ┗\青森       ┗\500.jpg      ┗\秋田       ┗\600.jpg       ┗\700.jpg  ┗\山   ┗\201801    ┗\01     ┗\東北      ┗\ABC.jpg      ┗\DEF.jpg      ┗\青森       ┗\100.jpg      ┗\秋田       ┗\100.jpg       ┗\200.jpg    ┗\02     ┗\東北      ┗\FGH.jpg      ┗\HIJ.jpg      ┗\青森       ┗\500.jpg      ┗\秋田       ┗\600.jpg       ┗\700.jpg

penta5431
質問者

補足

D:\色々 ┗\写真集  ┗\海   ┗\201801    ┗\01     ┗\ABC.jpg     ┗\DEF.jpg     ┗\100.jpg     ┗\100.jpg     ┗\200.jpg      ┗\東北      ┗\青森      ┗\秋田 と、言うようになるのが最終形です。 01フォルダ内に、あるフォルダは現状そのままです。 (たぶん、最終的には削除するんだとは思いますがどんなフォルダが あったのかを確認することがあるのでとりあえずはそのままです。 日付フォルダの下階層は、階層はありません。日付フォルダの中に、複数フォルダがありその中にはjpgファイルが入っているだけです。 (上記で、書いていただいた感じになっています。) 重複ファイルが、あるかないかと言われると分からないのですが(色々な人が同じメーカーのデジカメで撮ったものを集結させるのでないとは言えません。ただし、数枚上書きされたところでそれがあったのかなかったのかは誰にも分かりません。と、割り切るしかないですね) もし、捜索することになっても同じ名前だから上書きされたんだねってことにしかならないんですよね。工事写真の関係上、写真の名前を変更すると不正写真となりエラーするので・・・。

  • NuboChan
  • ベストアンサー率47% (785/1650)
回答No.1

それは、必ずexcelのマクロ(VBA)で処理しなければなりませんか? 単純にエキスプローラーやファイラーで処理すれば  ターゲットを日付フォルダーにしてそれより深い階層のファイルを全て   ターゲットフォルダーに移動できますが? この処理で少しは手抜きができます。 以下は、私が質問したときのURLです。 検索ワード:種類:NOT フォルダー  https://okwave.jp/qa/q9555043.html

関連するQ&A