回答編集履歴
2
同一フォルダ名が存在する場合のエラー回避処理追加
test
CHANGED
@@ -50,7 +50,9 @@
|
|
50
50
|
|
51
51
|
フォルダ名が固定でないことを踏まえ、For Each 構文の多重ループを使用してみました。
|
52
52
|
|
53
|
+
その後、移動先に同一フォルダ名が存在する場合のエラー回避処理を追加しました。
|
54
|
+
|
53
|
-
|
55
|
+
動作確認をしていませんが、参考にしてください。
|
54
56
|
|
55
57
|
```VBA
|
56
58
|
|
@@ -74,7 +76,15 @@
|
|
74
76
|
|
75
77
|
For Each fol3 In fol2.SubFolders
|
76
78
|
|
79
|
+
If FSO.FolderExists(ThisWorkbook.Path & "\画像\" & fol3.Name) Then
|
80
|
+
|
81
|
+
MsgBox "同一フォルダ名がありますので処理をスキップします。"
|
82
|
+
|
83
|
+
Else
|
84
|
+
|
77
|
-
|
85
|
+
FSO.MoveFolder CStr(fol3), ThisWorkbook.Path & "\画像\"
|
86
|
+
|
87
|
+
End If
|
78
88
|
|
79
89
|
Next fol3
|
80
90
|
|
1
For Each 構文の多重ループを用いたコード追記
test
CHANGED
@@ -45,3 +45,47 @@
|
|
45
45
|
Set FSO = Nothing
|
46
46
|
|
47
47
|
```
|
48
|
+
|
49
|
+
<追記>
|
50
|
+
|
51
|
+
フォルダ名が固定でないことを踏まえ、For Each 構文の多重ループを使用してみました。
|
52
|
+
|
53
|
+
動作確認をしていませんが、参考にしてください。
|
54
|
+
|
55
|
+
```VBA
|
56
|
+
|
57
|
+
'「画像」フォルダに移動
|
58
|
+
|
59
|
+
Dim FSO As FileSystemObject
|
60
|
+
|
61
|
+
Set FSO = New FileSystemObject
|
62
|
+
|
63
|
+
|
64
|
+
|
65
|
+
Dim fol1 As Folder, fol2 As Folder, fol3 As Folder
|
66
|
+
|
67
|
+
|
68
|
+
|
69
|
+
For Each fol1 In FSO.GetFolder(ThisWorkbook.Path).SubFolders
|
70
|
+
|
71
|
+
If fol1.Name <> "画像" Then
|
72
|
+
|
73
|
+
For Each fol2 In fol1.SubFolders
|
74
|
+
|
75
|
+
For Each fol3 In fol2.SubFolders
|
76
|
+
|
77
|
+
Call FSO.MoveFolder(fol3.Path, ThisWorkbook.Path & "\画像\")
|
78
|
+
|
79
|
+
Next fol3
|
80
|
+
|
81
|
+
Next fol2
|
82
|
+
|
83
|
+
End If
|
84
|
+
|
85
|
+
Next fol1
|
86
|
+
|
87
|
+
|
88
|
+
|
89
|
+
Set FSO = Nothing
|
90
|
+
|
91
|
+
```
|