| |
▼カド さん：
>>自分で地道に考えてみて、その中の部分的に分からないことがあれば、
>>またお尋ねしようと思います。
もう諦めちゃいましたか？
いちお、自分の想定してたコードで出来るのは確認できました。
参考までに。
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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
