回答編集履歴

2

コード修正

2018/06/23 17:43

投稿

hatena19
hatena19

スコア33620

test CHANGED
@@ -220,7 +220,7 @@
220
220
 
221
221
  With objFile
222
222
 
223
- If .Name Like "*.xls*" Then
223
+ If .Type = "Microsoft Excel ワークシート" Then
224
224
 
225
225
  i = i + 1
226
226
 

1

コードの追加

2018/06/23 17:43

投稿

hatena19
hatena19

スコア33620

test CHANGED
@@ -25,3 +25,221 @@
25
25
  リストボックスの2列表示については、下記をご参考に。
26
26
 
27
27
  [Office TANAKA - Excel VBA Tips[複数列のリストボックス]](http://officetanaka.net/excel/vba/tips/tips158.htm)
28
+
29
+
30
+
31
+ ツリービューで作成してみた
32
+
33
+ ---
34
+
35
+ 将来使うことがあるかもしれないので、ツリービューの勉強がてら作成してみました。
36
+
37
+
38
+
39
+ ![イメージ説明](ab57d1dc1a2151e214598bff0c9c7025.png)
40
+
41
+
42
+
43
+ ユーザーフォーム上にツリービュー(TreeView1)を配置します。
44
+
45
+ 配置の仕方は上記の Office TANAKA のリンク先を参考にしてください。
46
+
47
+ 他に下記のコントロールを配置します。
48
+
49
+ イメージリストと連携させてアイコンも表示できるようだが、私の環境ではエラーが出てアイコンが登録できなかったのでアイコンはなしです。
50
+
51
+
52
+
53
+ コマンドボタン
54
+
55
+ cmdBookPrint 選択したブックの印刷
56
+
57
+ cmdSelectFolder 親フォルダの選択
58
+
59
+
60
+
61
+ テキストボックス
62
+
63
+ txtRootFolder 親フォルダのパス格納用
64
+
65
+
66
+
67
+ ユーザーフォームのモジュール
68
+
69
+ ```vba
70
+
71
+ Option Explicit
72
+
73
+
74
+
75
+ Private Sub cmdBookPrint_Click()
76
+
77
+ Dim n As Node
78
+
79
+ For Each n In TreeView1.Nodes
80
+
81
+ If n.Checked And n.Children = 0 Then
82
+
83
+ Debug.Print n.FullPath
84
+
85
+ End If
86
+
87
+ Next
88
+
89
+ End Sub
90
+
91
+
92
+
93
+ Private Sub cmdSelectFolder_Click()
94
+
95
+ With Application.FileDialog(msoFileDialogFolderPicker)
96
+
97
+ .InitialFileName = txtRootFolder.Value
98
+
99
+ .AllowMultiSelect = False
100
+
101
+ .Title = "親フォルダの選択"
102
+
103
+ If .Show Then txtRootFolder.Value = .SelectedItems(1)
104
+
105
+ End With
106
+
107
+ TreeView1.Nodes.Clear
108
+
109
+ InitFileTreeView
110
+
111
+ End Sub
112
+
113
+
114
+
115
+ Private Sub UserForm_Initialize()
116
+
117
+ txtRootFolder.Value = "C:\PFolder"
118
+
119
+ With TreeView1
120
+
121
+ .CheckBoxes = True
122
+
123
+ .Indentation = 14 ''インデントの幅
124
+
125
+ .LabelEdit = tvwManual ''ラベル編集の許可
126
+
127
+ .BorderStyle = ccNone ''線の種類
128
+
129
+ .HideSelection = False ''非アクティブ時の選択解除
130
+
131
+ .LineStyle = tvwRootLines ''ルート(最上位)線の表示
132
+
133
+ End With
134
+
135
+
136
+
137
+ InitFileTreeView
138
+
139
+ End Sub
140
+
141
+
142
+
143
+ Sub InitFileTreeView()
144
+
145
+ Dim objFSO As FileSystemObject
146
+
147
+ Dim strDir As String
148
+
149
+ Dim i As Long
150
+
151
+
152
+
153
+ strDir = txtRootFolder.Value
154
+
155
+ 'FileSystemObjectのインスタンスの生成
156
+
157
+ Set objFSO = New FileSystemObject
158
+
159
+ 'フォルダの存在確認
160
+
161
+ If Not objFSO.FolderExists(strDir) Then
162
+
163
+ MsgBox ("指定のフォルダは存在しません")
164
+
165
+ Exit Sub
166
+
167
+ End If
168
+
169
+ '親フォルダーの登録、展開
170
+
171
+ TreeView1.Nodes.Add(Key:="n0", Text:=strDir).Expanded = True
172
+
173
+ i = 1 'キーインデックス
174
+
175
+ '再帰処理モジュールのコール
176
+
177
+ Call GetDirFiles(objFSO.GetFolder(strDir), i, "n0")
178
+
179
+ 'オブジェクトの解放
180
+
181
+ Set objFSO = Nothing
182
+
183
+ End Sub
184
+
185
+
186
+
187
+ Sub GetDirFiles(ByVal objFolder As Folder, ByRef i As Long, ByVal PKey As String)
188
+
189
+ Dim objFolderSub As Folder, objFile As File
190
+
191
+ Dim n As Node
192
+
193
+ 'サブフォルダの取得
194
+
195
+ For Each objFolderSub In objFolder.SubFolders
196
+
197
+ i = i + 1
198
+
199
+ Set n = TreeView1.Nodes.Add(Relative:=PKey, Relationship:=tvwChild, _
200
+
201
+ Key:="n" & i, Text:=objFolderSub.Name)
202
+
203
+ Call GetDirFiles(objFolderSub, i, "n" & i)
204
+
205
+ If n.Children = 0 Then
206
+
207
+ TreeView1.Nodes.Remove n.Index
208
+
209
+ Else
210
+
211
+ n.Expanded = True
212
+
213
+ End If
214
+
215
+ Next
216
+
217
+ 'ファイルの取得
218
+
219
+ For Each objFile In objFolder.Files
220
+
221
+ With objFile
222
+
223
+ If .Name Like "*.xls*" Then
224
+
225
+ i = i + 1
226
+
227
+ TreeView1.Nodes.Add Relative:=PKey, Relationship:=tvwChild, _
228
+
229
+ Key:="n" & i, Text:=.Name
230
+
231
+ End If
232
+
233
+ End With
234
+
235
+ Next
236
+
237
+ 'オブジェクトの解放
238
+
239
+ Set objFolderSub = Nothing
240
+
241
+ Set objFile = Nothing
242
+
243
+ End Sub
244
+
245
+ ```