回答編集履歴

3

ミス修正

2021/03/20 03:44

投稿

xail2222
xail2222

スコア1508

test CHANGED
@@ -68,7 +68,7 @@
68
68
 
69
69
  ' サブフォルダ配下のファイルを全て取得
70
70
 
71
- buf = Dir(tFolder & "\" & tSubFolders(tIndSubFolder) & "*.*")
71
+ buf = Dir(fd_path & "\" & tSubFolders(tIndSubFolder) & "*.*")
72
72
 
73
73
  Do While buf <> ""
74
74
 

2

処理追記

2021/03/20 03:44

投稿

xail2222
xail2222

スコア1508

test CHANGED
@@ -13,3 +13,75 @@
13
13
  すみません追記見てなかった。みんなコメントしてるじゃん。
14
14
 
15
15
  1階層なら再帰関数使わなくていいし!
16
+
17
+
18
+
19
+ ---
20
+
21
+ (追記 2021/03/20)
22
+
23
+ 再帰呼び出しまでしなくてよさそうなので、1階層したのファイルをログに出すだけの処理を記載します。
24
+
25
+
26
+
27
+ ```VBA
28
+
29
+ Dim tFolder As String
30
+
31
+ Dim tSubFolders() As String
32
+
33
+ Dim tIndSubFolder As Long
34
+
35
+ Dim tIndFile As Long
36
+
37
+
38
+
39
+ ' サブフォルダをすべて取得
40
+
41
+ tIndSubFolder = 0
42
+
43
+ buf = Dir(fd_path & "*.*", vbDirectory)
44
+
45
+ Do While buf <> ""
46
+
47
+ If GetAttr(fd_path & "\" & buf) And vbDirectory Then
48
+
49
+ If buf <> "." And buf <> ".." Then
50
+
51
+ ReDim Preserve tSubFolders(tIndSubFolder)
52
+
53
+ tSubFolders(tIndSubFolder) = buf
54
+
55
+ tIndSubFolder = tIndSubFolder + 1
56
+
57
+ End If
58
+
59
+ End If
60
+
61
+ buf = Dir()
62
+
63
+ Loop
64
+
65
+ If tIndSubFolder > 0 Then
66
+
67
+ For tIndSubFolder = 0 To UBound(tSubFolders)
68
+
69
+ ' サブフォルダ配下のファイルを全て取得
70
+
71
+ buf = Dir(tFolder & "\" & tSubFolders(tIndSubFolder) & "*.*")
72
+
73
+ Do While buf <> ""
74
+
75
+ Debug.Print tSubFolders(tIndSubFolder) & "\" & buf
76
+
77
+ buf = Dir()
78
+
79
+ Loop
80
+
81
+ Next
82
+
83
+ End If
84
+
85
+ ```
86
+
87
+ 埋め込みまではしてないですが

1

追記

2021/03/20 03:43

投稿

xail2222
xail2222

スコア1508

test CHANGED
@@ -3,3 +3,13 @@
3
3
 
4
4
 
5
5
  [再帰処理でフォルダー一覧を作成するサンプルマクロ](https://www.relief.jp/docs/excel-vba-recursive-list-folders.html)
6
+
7
+
8
+
9
+ ---
10
+
11
+
12
+
13
+ すみません追記見てなかった。みんなコメントしてるじゃん。
14
+
15
+ 1階層なら再帰関数使わなくていいし!