回答編集履歴
2
同一フォルダ名が存在する場合のエラー回避処理追加
answer
CHANGED
|
@@ -24,7 +24,8 @@
|
|
|
24
24
|
```
|
|
25
25
|
＜追記＞
|
|
26
26
|
フォルダ名が固定でないことを踏まえ、For Each 構文の多重ループを使用してみました。
|
|
27
|
+
その後、移動先に同一フォルダ名が存在する場合のエラー回避処理を追加しました。
|
|
27
|
-
|
|
28
|
+
動作確認をしていませんが、参考にしてください。
|
|
28
29
|
```VBA
|
|
29
30
|
'「画像」フォルダに移動
|
|
30
31
|
Dim FSO As FileSystemObject
|
|
@@ -36,7 +37,11 @@
|
|
|
36
37
|
If fol1.Name <> "画像" Then
|
|
37
38
|
For Each fol2 In fol1.SubFolders
|
|
38
39
|
For Each fol3 In fol2.SubFolders
|
|
40
|
+
If FSO.FolderExists(ThisWorkbook.Path & "\画像\" & fol3.Name) Then
|
|
41
|
+
MsgBox "同一フォルダ名がありますので処理をスキップします。"
|
|
42
|
+
Else
|
|
39
|
-
|
|
43
|
+
FSO.MoveFolder CStr(fol3), ThisWorkbook.Path & "\画像\"
|
|
44
|
+
End If
|
|
40
45
|
Next fol3
|
|
41
46
|
Next fol2
|
|
42
47
|
End If
|
1
For Each 構文の多重ループを用いたコード追記
answer
CHANGED
|
@@ -21,4 +21,26 @@
|
|
|
21
21
|
Next FSOfolder
|
|
22
22
|
|
|
23
23
|
Set FSO = Nothing
|
|
24
|
+
```
|
|
25
|
+
＜追記＞
|
|
26
|
+
フォルダ名が固定でないことを踏まえ、For Each 構文の多重ループを使用してみました。
|
|
27
|
+
動作確認をしていませんが、参考にしてください。
|
|
28
|
+
```VBA
|
|
29
|
+
'「画像」フォルダに移動
|
|
30
|
+
Dim FSO As FileSystemObject
|
|
31
|
+
Set FSO = New FileSystemObject
|
|
32
|
+
|
|
33
|
+
Dim fol1 As Folder, fol2 As Folder, fol3 As Folder
|
|
34
|
+
|
|
35
|
+
For Each fol1 In FSO.GetFolder(ThisWorkbook.Path).SubFolders
|
|
36
|
+
If fol1.Name <> "画像" Then
|
|
37
|
+
For Each fol2 In fol1.SubFolders
|
|
38
|
+
For Each fol3 In fol2.SubFolders
|
|
39
|
+
Call FSO.MoveFolder(fol3.Path, ThisWorkbook.Path & "\画像\")
|
|
40
|
+
Next fol3
|
|
41
|
+
Next fol2
|
|
42
|
+
End If
|
|
43
|
+
Next fol1
|
|
44
|
+
|
|
45
|
+
Set FSO = Nothing
|
|
24
46
|
```
|