| |
▼にしもり さん：
>確かに処理順がおかしいのでご教示いただいたMicrosoft Scripting Runtime の方法を使わせていただきました。
>希望通りに出来ました。
>サブディレクトリー名を表示しない方法についてもありがとうございました。
>ただサブディレクトリー名は表示させたいので実際には用いませんでした。
補足ですが、たとえば
C:\_cosmos\Tr フォルダの中が 以下のような構成になっているとき、
C:\_cosmos\Tr
┃
┣━ aaa
┃ 111.xls
┃
┣━ bbb
┃ 222.xls
┃
┗━ ccc
333.xls
Fsoを使う方法
Set oFolder = Fso.GetFolder("C:\_cosmos\Tr")
FileSearch2 oFolder, 1 '2行目から書き出す
で FileSearch2 を呼び出しますと、
[FileSearch2]
2 C:\_cosmos\Tr\aaa\111.xls
3 C:\_cosmos\Tr\bbb\222.xls
4 C:\_cosmos\Tr\ccc\333.xls
というファイルリストが出力されます。
（こういうリストが出力されればいいのですよね？）
ところが、(Fsoは遅いので) もっと高速に一覧を得ようとして
n = SearchFiles("C:\_cosmos\Tr", "*.*", FoundFiles())
で Dirコマンドを呼び出すと、
----------------
C:\_cosmos\Tr\aaa
C:\_cosmos\Tr\bbb
C:\_cosmos\Tr\ccc
C:\_cosmos\Tr\aaa\111.xls
C:\_cosmos\Tr\bbb\222.xls
C:\_cosmos\Tr\ccc\333.xls
というファイル一覧が得られるのです。
こうなってしまうのは
Dirコマンドのオプションを
sCmd = "DIR """ & Filename & """ /b/s/o:N > """ & tmpPath & """"
としていたからです。
[FileSearch2]
と同様の結果が欲しいなら、オプションは
sCmd = "DIR """ & Filename & """ /b/s/a:-D/o:N > """ & tmpPath & """"
'' /b ファイル名のみ
'' /s サブディレクトリも検索
'' /a/:-D サブディレクトリー名は表示しない
'' /o:N 名前順でソート
としなくてはいけません。
※なお、Dirコマンドの一時ファイル出力先を 対象フォルダ として
いたのは、全ファイルが検索対象のときそれも表示され都合が悪かったので
WindowsのTEMPフォルダ内に作成することにしました。
参考のため、それを以下に再掲しておきます。
'//サブフォルダを含むファイルの一覧 【一時ファイル先 修正後】
Function SearchFiles(LookIn As String, Filename As String, _
FoundFiles() As String) As Long
Dim i As Long
Dim Ext As Variant
Dim tmpPath As String
Dim sCmd As String
Dim ko As Long
If Right$(LookIn, 1) <> "\" Then LookIn = LookIn & "\"
If InStr(Filename, ";") > 0 Then '複数ファイルタイプ対応
Ext = Split(Filename, ";") '例 "*.csv;*.xls"
For i = 0 To UBound(Ext)
Ext(i) = LookIn & Ext(i)
Next
Filename = Join(Ext, """ """)
Else
Filename = LookIn & Filename
End If
tmpPath = Environ$("TEMP") & "\Dir.tmp" '●一時ファイル出力先
sCmd = "DIR """ & Filename & """ /b/s/a:-D/o:N > """ & tmpPath & """"
'' /b ファイル名のみ
'' /s サブディレクトリも検索
'' /a/:-D サブディレクトリー名は表示しない●
'' /o:N 名前順でソート
With CreateObject("WScript.Shell")
ko = .Run("CMD /C " & sCmd, 7, True) 'Dirコマンド実行
End With
If ko Then
MsgBox "ファイルの検索に失敗しました", , LookIn
Exit Function
End If
If FileLen(tmpPath) < 2 Then Exit Function
Dim io As Integer
Dim buf() As Byte
io = FreeFile()
Open tmpPath For Binary As io
ReDim buf(1 To LOF(io))
Get #io, , buf
Close io
Kill tmpPath
FoundFiles() = Split(StrConv(buf, vbUnicode), vbCrLf)
ko = UBound(FoundFiles)
ReDim Preserve FoundFiles(ko - 1)
SearchFiles = ko
End Function
|
|
kanabun
- 13/5/24(金) 9:18 -
