| |
▼にしもり さん：
以下のFunction ですが、
実際にDirをとってみたら、サブフォルダ名まで書き出していましたので
Dirコマンドのパラメータに /a:-D を追加して
「サブディレクトリー名は表示しない」
ように修正しました。
>'//サブフォルダを含むファイルの一覧
>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, ";")
> For i = 0 To UBound(Ext)
> Ext(i) = LookIn & Ext(i)
> Next
> Filename = Join(Ext, """ """)
> Else
> Filename = LookIn & Filename
> End If
> tmpPath = LookIn & "Dir.tmp" 'Dirの結果を一時ファイルに出力
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/23(木) 20:08 -
