質問編集履歴

1

コードを追加

2018/01/30 05:16

投稿

ExcelVBAer
ExcelVBAer

スコア1175

test CHANGED
File without changes
test CHANGED
@@ -93,3 +93,113 @@
93
93
 
94
94
 
95
95
  ```
96
+
97
+
98
+
99
+ ファイル検索用の関数を追記いたします(1/30)
100
+
101
+ ```VBA
102
+
103
+ Public Function fFile_Path_in_Folder(Path_Folder As String, _
104
+
105
+ Optional Extention As String = "*", _
106
+
107
+ Optional FileAttribute As VbFileAttribute = vbNormal) As Variant
108
+
109
+
110
+
111
+
112
+
113
+ '- 指定フォルダが無かった場合、終了
114
+
115
+ If FSO.FolderExists(Path_Folder) = False Then Exit Function
116
+
117
+
118
+
119
+ 'フォルダパスを格納
120
+
121
+ Dim Path_FD As String
122
+
123
+ Path_FD = Path_Folder
124
+
125
+ If Right$(Path_FD, 1) <> Application.PathSeparator Then
126
+
127
+ Path_FD = Path_FD & Application.PathSeparator
128
+
129
+ End If
130
+
131
+
132
+
133
+ Dim Dic As Scripting.Dictionary
134
+
135
+ Set Dic = New Scripting.Dictionary
136
+
137
+
138
+
139
+ '最初のファイルパスを取得
140
+
141
+ 'Dir関数に検索パスを設定
142
+
143
+ Dim FileName As String
144
+
145
+ FileName = Dir(Path_FD & "*" & "." & Extention, FileAttribute)
146
+
147
+
148
+
149
+ Do While FileName <> ""
150
+
151
+
152
+
153
+ Call fDoEvents
154
+
155
+
156
+
157
+ Dim Path_File As String
158
+
159
+ Path_File = Path_FD & FileName
160
+
161
+
162
+
163
+ 'ファイルパスを辞書に登録
164
+
165
+ If Directory_IsFolder(Path_File) = False Then
166
+
167
+ Dic.Item(FileName) = Path_File
168
+
169
+ End If
170
+
171
+
172
+
173
+ '次のファイルパスを取得
174
+
175
+ FileName = Dir()
176
+
177
+
178
+
179
+ Loop
180
+
181
+
182
+
183
+ 'ファイルロックの開放(念のため)
184
+
185
+ Call Dir(vbNullString)
186
+
187
+
188
+
189
+ If Dic.Count = 0 Then Exit Function
190
+
191
+
192
+
193
+ '- 戻り値
194
+
195
+ fFile_Path_in_Folder = Dic.Items
196
+
197
+
198
+
199
+ Set Dic = Nothing
200
+
201
+
202
+
203
+ End Function
204
+
205
+ ```