Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

38510 / 76732

←次へ　｜　前へ→


	【43357】Re:フォルダを自動で並び替えて整理したい

ハチ - 06/10/11(水) 12:48 -


	引用なし

	パスワード

▼カドさん：
>>自分で地道に考えてみて、その中の部分的に分からないことがあれば、
>>またお尋ねしようと思います。

もう諦めちゃいましたか？

いちお、自分の想定してたコードで出来るのは確認できました。
参考までに。

Option Explicit

Sub FSO_Test()
　　Dim FSO As Object　　　 'Scripting.FileSystemObject
　　Dim Ro_Fol As Object　　'親フォルダ
　　Dim Ko_Fol As Object　　'子フォルダ
　　Dim Mago_Fol As Object　'孫フォルダ
　　Dim myFile As Object　　'フォルダ内のファイル
　　Dim NewPath As String　 '新しいパス
　　Dim KoPath As String　 'フォルダ作成用のパス
　　Dim Des_Ro As String　　'再構成先のルートパス
　　
　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　Set Ro_Fol = FSO.GetFolder(ThisWorkbook.Path)
　　
　　Des_Ro = ThisWorkbook.Path & "\並び替え後"
　　Chk_MkDir (Des_Ro)
　　
　　For Each Ko_Fol In Ro_Fol.SubFolders
　　　　If Ko_Fol.Path <> Des_Ro Then
　　　　　　For Each Mago_Fol In Ko_Fol.SubFolders
　　　　　　　　'フォルダ生成
　　　　　　　　KoPath = Des_Ro & "\" & Mago_Fol.Name
　　　　　　　　Chk_MkDir (KoPath)
　　　　　　　　NewPath = KoPath & "\" & Ko_Fol.Name
　　　　　　　　Chk_MkDir (NewPath)
　　　　　　　　'ファイルコピー
　　　　　　　　For Each myFile In Mago_Fol.Files
　　　　　　　　　　myFile.Copy NewPath & "\" & myFile.Name
　　　　　　　　Next myFile
　　　　　　Next Mago_Fol
　　　　　　'Ko_Fol.Delete　 '削除は十分テストしてから
　　　　End If
　　Next Ko_Fol
　　
　　Set Ro_Fol = Nothing
　　Set FSO = Nothing
End Sub

Sub Chk_MkDir(StrPath)
　　If Dir(StrPath, vbDirectory) = "" Then MkDir (StrPath)
End Sub

2 hits

▼

【43185】フォルダを自動で並び替えて整理したい カド 06/10/5(木) 8:43