| |
▼ｒ さん：
>VBAでファイルを検索して開く際に、部分一致でファイルを探してきて開くことは可能なのでしょうか。
>部分一致で探したいんです。
検索パターンを指定して、検索フォルダを指定し、
ヒットしたファイルを表示するコード例です。
Sub Try1()
Call SearchFile("abc*.csv") '検索パターン
End Sub
Private Sub SearchFile(Filename As String)
Dim myFolder As String
'検索のトップフォルダをダイアログで指定
Dim oFolder As Object
Const BIF_RETURNNONLYFSDIRS = &H1 'ディレクトリのみ選択可
Const BIF_EDITBOX = &H10 'アイテム名入力用のEdit_boxを表示
Dim hWnd As Long
hWnd = Application.hWnd
With CreateObject("Shell.Application")
Set oFolder = .BrowseForFolder(hWnd, _
"フォルダを選択して下さい", _
BIF_RETURNNONLYFSDIRS Or BIF_EDITBOX, _
CreateObject("WScript.Shell").SpecialFolders("DeskTop"))
If (oFolder Is Nothing) Then Exit Sub
myFolder = oFolder.Self.Path
End With
If Right$(myFolder, 1) <> "\" Then myFolder = myFolder & "\"
'サブフォルダを含むファイルのワイルドカード検索
Dim FoundFiles() As String
Dim tmpPath As String
Dim sCmd As String
Dim ko As Long
'---- Dirコマンドによるサブフォルダを含むファイル名の検索
Filename = myFolder & Filename
tmpPath = Environ$("Temp") & "\Dir.tmp" '一時ファイルパス
sCmd = "DIR """ & Filename & """ /b/s/a:-D > """ & tmpPath & """"
'' /b ファイル名のみ
'' /s サブディレクトリも検索
'' /a:-D サブディレクトリー名は表示しない
With CreateObject("WScript.Shell")
ko = .Run("CMD /C " & sCmd, 7, True) 'Dirコマンド実行
End With
If ko Then
MsgBox "ファイルの検索に失敗しました", , Filename
Exit Sub
End If
If FileLen(tmpPath) < 2 Then Exit Sub 'ファイルが見つからなかった
'----- Dirコマンドで取得したファイル名を配列に格納
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)
MsgBox ko & "個のファイルがみつかりました" & vbCr _
& Join(FoundFiles(), vbCr)
End Sub
ヒットしたファイルは複数あるかもしれないので、とりあえずMsgBoxに
表示しています。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
