teratail header banner
teratail header banner
質問するログイン新規登録

質問編集履歴

1

コードを追加

2018/01/30 05:16

投稿

ExcelVBAer
ExcelVBAer

スコア1175

title CHANGED
File without changes
body CHANGED
@@ -45,4 +45,59 @@
45
45
 
46
46
  End Function
47
47
 
48
+ ```
49
+
50
+ ファイル検索用の関数を追記いたします(1/30)
51
+ ```VBA
52
+ Public Function fFile_Path_in_Folder(Path_Folder As String, _
53
+ Optional Extention As String = "*", _
54
+ Optional FileAttribute As VbFileAttribute = vbNormal) As Variant
55
+
56
+
57
+ '- 指定フォルダが無かった場合、終了
58
+ If FSO.FolderExists(Path_Folder) = False Then Exit Function
59
+
60
+ 'フォルダパスを格納
61
+ Dim Path_FD As String
62
+ Path_FD = Path_Folder
63
+ If Right$(Path_FD, 1) <> Application.PathSeparator Then
64
+ Path_FD = Path_FD & Application.PathSeparator
65
+ End If
66
+
67
+ Dim Dic As Scripting.Dictionary
68
+ Set Dic = New Scripting.Dictionary
69
+
70
+ '最初のファイルパスを取得
71
+ 'Dir関数に検索パスを設定
72
+ Dim FileName As String
73
+ FileName = Dir(Path_FD & "*" & "." & Extention, FileAttribute)
74
+
75
+ Do While FileName <> ""
76
+
77
+ Call fDoEvents
78
+
79
+ Dim Path_File As String
80
+ Path_File = Path_FD & FileName
81
+
82
+ 'ファイルパスを辞書に登録
83
+ If Directory_IsFolder(Path_File) = False Then
84
+ Dic.Item(FileName) = Path_File
85
+ End If
86
+
87
+ '次のファイルパスを取得
88
+ FileName = Dir()
89
+
90
+ Loop
91
+
92
+ 'ファイルロックの開放(念のため)
93
+ Call Dir(vbNullString)
94
+
95
+ If Dic.Count = 0 Then Exit Function
96
+
97
+ '- 戻り値
98
+ fFile_Path_in_Folder = Dic.Items
99
+
100
+ Set Dic = Nothing
101
+
102
+ End Function
48
103
  ```