![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?8acaa2e)
お世話になります。
あるフォルダの中に、たくさんフォルダが入っています。
子フォルダのファイルを全て親フォルダに移すのですが、同名ファイルがある可能性があります。
同名ファイルは枝番をつけるなどして処理するのですが、あらかじめ同名ファイルがあるかどうかを調べたいのです。
親フォルダの中にエクセルを入れておき、マクロの実行の結果、エクセルのシートに同名ファイルの情報を表示できればと思っています。
例)もし同名ファイルがあった場合、
まずセルA1にファイル名、B1に拡張子を表示する。123.xlsの場合 A1に123 B1に.xls そしてそのファイルが入っているフォルダ名をB2以降のB列に表示する。
3つのフォルダにA1のファイル名のデータがあれば、B2,B3,B4にそのフォルダ名が表示される。
もちろん同名ファイルが1組とは限りません。
2つ目以降はB列のフォルダ名が入った下の行のA列(上の例だとA5)にファイル名が入る。
この繰り返しです。
また、もし1つの同名ファイルがなかった場合は、A1に「同名ファイルなし」と表示させます。
ちなみに重複の場合の枝番の付け方に規則性がないため手作業で行いますが、枝番をつけて同名ファイルを無くした
あとにまとめて親フォルダに全データを移すこともマクロで可能ならアドバイスください。
フォルダ構成は1つの親フォルダに対して複数の子フォルダで、孫フォルダはありません。
OSはWinXP、Excelは2002です。
よろしくお願いします。
No.3ベストアンサー
- 回答日時:
No.2です。
ファイル移動のマクロで、移動中のファイルの進行状況を左下のステータスバーに表示し、終了したらダイアログを出すとともにB1に「移動完了しました」と出すようにしてみました。マクロを以下のものに差し替えて試してください。
Sub ファイル移動()
Dim RootPath As String
Dim i As Integer
Dim FSO As Object
Dim D As Object, F As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
RootPath = ThisWorkbook.Path & "\"
i = 1
For Each D In FSO.GetFolder(RootPath).SubFolders
For Each F In FSO.GetFolder(RootPath & D.Name).Files
Application.StatusBar = "ファイル移動中: " & i & "ファイル完了 "
Name RootPath & D.Name & "\" & F.Name As RootPath & F.Name
i = i + 1
Next
Next
Set FSO = Nothing
Application.StatusBar = ""
MsgBox ("終了しました。")
ActiveSheet.Range("B1").Value = "移動完了しました。"
End Sub
No.2
- 回答日時:
ちょうど先日に同じようなものを作ったので、それを流用して作ってみました。
●同名ファイルの抽出マクロ
Sub 重複ファイル抽出()
Dim RootPath As String
Dim i As Integer
Dim IsDuplicated As Boolean
Dim FSO As Object
Dim D As Object, F As Object
Dim r As Range
Dim TmpWS As Worksheet, WS As Worksheet
Application.ScreenUpdating = False
Set WS = ActiveSheet
WS.Cells.ClearContents
'ワーク用のテンポラリシートを追加
Set TmpWS = Worksheets.Add
Set FSO = CreateObject("Scripting.FileSystemObject")
RootPath = ThisWorkbook.Path & "\"
'ファイル一覧をテンポラリシートに出力
'A列:フォルダー名、B列、ファイル名
i = 1
For Each D In FSO.GetFolder(RootPath).SubFolders
For Each F In FSO.GetFolder(RootPath & D.Name).Files
Cells(i, "A").Value = D.Name
Cells(i, "B").Value = F.Name
i = i + 1
Next
Next
'ファイル名をキーにしてソート
Columns("A:B").Sort Key1:=Range("B1")
'同名ファイルがあるかチェック
i = 0: IsDuplicated = False
For Each r In Range("B1", Cells(Rows.Count, "B").End(xlUp))
If StrConv(r.Value, vbLowerCase) = StrConv(r.Offset(1).Value, vbLowerCase) Then
If IsDuplicated = False Then
i = i + 1
WS.Cells(i, 1).Value = FSO.GetBaseName(r.Value)
WS.Cells(i, 2).Value = FSO.GetExtensionName(r.Value)
IsDuplicated = True
End If
i = i + 1
WS.Cells(i, 2).Value = r.Offset(, -1).Value
ElseIf IsDuplicated Then
i = i + 1
WS.Cells(i, 2).Value = r.Offset(, -1).Value
IsDuplicated = False
End If
Next
If i = 0 Then
WS.Range("A1").Value = "同名ファイルなし"
End If
'テンポラリシートを削除
Application.DisplayAlerts = False
TmpWS.Delete
Application.DisplayAlerts = True
Set FSO = Nothing
End Sub
●子フォルダ配下のファイルをまとめて移動するマクロ
Sub ファイル移動()
Dim RootPath As String
Dim i As Integer
Dim FSO As Object
Dim D As Object, F As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
RootPath = ThisWorkbook.Path & "\"
i = 1
For Each D In FSO.GetFolder(RootPath).SubFolders
For Each F In FSO.GetFolder(RootPath & D.Name).Files
Name RootPath & D.Name & "\" & F.Name As RootPath & F.Name
i = i + 1
Next
Next
Set FSO = Nothing
End Sub
この回答への補足
回答ありがとうございます。試した結果、両方とも問題なく動作してくれました。ありがとうございます。ちなみに「子フォルダ配下のファイルをまとめて移動するマクロ」で処理完了後にB1セルに「移動完了しました」などと表示できますか?数千件のデータを移動させたりするので・・・
補足日時:2007/03/29 00:07No.1
- 回答日時:
ここまでガチガチに個人的なAPを要求するのですか^^;
別の方法をお教えしますので試してみてください。
COMMAND画面を起動して
>D: Enter → 目的のドライブ名
>CD \aaa Enter → 親フォルダ名
>TREE /F > D:\TREE.TXT Enter → ファイルTreeを二にのファイルに書きだす
>EXIT → COMMANDを終わる
これでD:\TREE.TXTというファイルができあがります。内容をみると子フォルダも含めてファイルリストが入っているはずです。
これをEXCELで読み込みます。すると全てがA列に読み込まれるはずです。(テキストファイルウィザード経由です)
次に何文字か置換します。置換ウィザードはCtrl+Hで起動します。
「─」 → 「\」(置換後の文字に半角¥を指定)
「│」 → 「ブランク」(置換後の文字に何も入れずに置換)
「├」 → 「ブランク」
「└」 → 「ブランク」
「半角スペース」→「ブランク」
ここまでの操作でA列にファイル名がきれいに入ります。頭に「¥」が着いているのは子フォルダです。
B1に以下の式を入れて下方向にコピーすると、結果が2以上の項目が重複している項目ということになります。
=COUNTIF(A:A,A1)
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) 【VBA】指定フォルダに格納中のテキストファイルをエクセルで処理し結果のエクセルを新規フォルダに保存 1 2022/03/25 14:19
- Excel(エクセル) 【マクロ】エラーが発生⇒実行時エラー58既に同名のファイルが存在 5 2022/08/31 10:03
- Excel(エクセル) Excel、同じフォルダ内のExcelファイルの特定シートのみを1つのファイルに集約したい 8 2022/09/07 15:12
- Visual Basic(VBA) エクセルのマクロについて教えてください マクロを実行して 作業フォルダの中にある PDFファイル名を 3 2023/07/01 15:16
- Excel(エクセル) 【VBA】フォルダAにある2つのファイルの内1つを、フォルダBへ。もう1つを、フォルダBへ移動したい 6 2022/07/26 08:51
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/08/08 11:02
- システム vba シートの追加について 2 2023/05/17 15:58
- Visual Basic(VBA) 顧客ごとに違う点検案内を作成するマクロ 4 2022/09/16 05:34
- Excel(エクセル) 【VBAファイル移動】2つのマクロを順に実行。1つ目のマクロが実行不可⇒2つ目が実行不可となる件 2 2022/07/29 12:17
- XML エクセルのマクロについて教えてください。 3 2023/02/06 09:06
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
onedriveで同期解除をしたら、...
-
沢山のフォルダにあるファイル...
-
マイドキュメントのフォルダの...
-
ファイルのプロパティの属性の...
-
エクセル:マクロでの同名ファ...
-
PDFを結合すると語句検索できな...
-
フォルダの上書きで、上書きさ...
-
EXCEL ハイパーリンクが開かない
-
ファイルをコピーしたとき、も...
-
excel2016 データ貼り付けでき...
-
USBメモリの表示する「残り時間」
-
一つのフォルダに入るファイル...
-
ファイルパスのチルダの意味
-
1つのフォルダには何個までのフ...
-
「隠しファイル・フォルダを別...
-
異なるファイルに入った複数の...
-
ウムラオトなど欧文記号の付い...
-
スクリーンセイバー
-
別フォルダにある音楽ファイル...
-
ウルティマオンライン第3の夜明...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
onedriveで同期解除をしたら、...
-
沢山のフォルダにあるファイル...
-
マイドキュメントのフォルダの...
-
ファイルパスのチルダの意味
-
ファイルのプロパティの属性の...
-
Windowsファイルエクスプローラ...
-
ファイルをコピーしたとき、も...
-
USB内のフォルダが「ファイル」...
-
スマホのブックマークはどこに...
-
移動先にないファイルのみをコ...
-
Batファイルでxcopyを実行する...
-
非圧縮のZIPファイルを作りたい...
-
一つのフォルダに入るファイル...
-
Ubuntu でinvalid filenameとな...
-
VBAで複数のフォルダから最新の...
-
「隠しファイル・フォルダを別...
-
動画のサイズと再生時間の長さの件
-
異なるファイルに入った複数の...
-
フォルダ内のファイルを取得し...
-
win10 ファイルを自由に移動配...
おすすめ情報