【ExcelVBA】指定したファイル名をAドライブで検索

質問

エクセルVBAで、指定したファイル名のファイルをAドライブ直下で検索した場合、ワイルドカードを使ってないにも関わらず、ワイルドカード検索みたいな感じで結果がとれてしまいます。

■Aドライブ直下
aaaPROFILE.xls
testPROFILE.xls

■コード
With Application.FileSearch
.NewSearch
.LookIn = "A:\"
.SearchSubFolders = True
.Filename = "PROFILE.xls"
If .Execute() > 0 Then
MsgBox Application.FileSearch.FoundFiles(1) & "あった"
Else
MsgBox "Aドライブに[PROFILE.xls]を保存してね"
End If
End With

これを実行すると、「Aドライブに[PROFILE.xls]を保存してね」というメッセージが出てほしいのですが、「aaaPROFILE.xlsあった」とでてきてしまい、aaaPROFILE.xlsが検索結果にひっかかってしまいます。

これは何故でしょうか？どうしたら指定した文字列をビタで検索できるでしょうか？
ご回答よろしくお願いいたします。

回答No.5

nicotinism · ベストアンサー

Application.FileSearch はインデックスサービスが有効の場合
正しい結果が得られない事が有ります。
あるのに見つけてこなかったり・・・無いのにカウントされたり・・・
リンクは参考URLの文字制限に引っかかって張れなかったので
Application FileSearch インデックスサービス でGoogleって見て下さい
http://www.google.com/search?hl=ja&lr=lang_ja&ie=SJIS&oe=SJIS&num=100&q=Application+FileSearch+%83C%83%93%83f%83b%83N%83X%83T%81%5B%83r%83X
（↑は見えるかな）なので
WindowAPIやFileSystemObjectなどを使ったほうが無難です。
下記のようなのを標準モジュールに置いといて
Dim i As Long
i = MyFileSearch("c:\","*.xls")
If i > 0 Then
MsgBox i & "あった"
としてみては？

Option Explicit
Option Compare Text '大文字小文字を区別しない

'使い方 MyFileSearch("c:\","*.xls")
Function MyFileSearch( _
　　　　　　strTrgDir As String, strTrgFile As String, _
　　　　　　Optional FilesCount As Long = 0) As Long
　　On Error GoTo errHnd
　　Dim objFs As Object
　　Dim objDir As Object
　　Dim objTmpFile As Object
　　Dim i As Long

　　Set objFs = CreateObject("Scripting.FileSystemObject")
　　Set objDir = objFs.Getfolder(strTrgDir)
　　Set objTmpFile = objDir.Files

　　For Each objTmpFile In objDir.Files
　　　　If objTmpFile.Name Like strTrgFile Then
　　　　　　FilesCount = FilesCount + 1
　　　　　　Debug.Print "FileName = ", objTmpFile.Name, objTmpFile.Path
　　　　End If
　　Next

　　For Each objDir In objDir.SubFolders
　　　　'Debug.Print "folder = ", objDir.Name, objDir.Attributes
　　　　If objDir.Attributes <> 22 Then
　　　　　　Call MyFileSearch(objDir.Path, strTrgFile, FilesCount)
　　　　End If
　　Next
　　MyFileSearch = FilesCount
　　Set objFs = Nothing
　　Exit Function
errHnd:
　　MyFileSearch = -1
　　Set objFs = Nothing
End Function

お礼

あーなるほど！ご提示いただいた内容でしたら使いまわしもできますしね…！本当参考になります。
FileSearchはあまり好ましくないようですね…改修を検討します。
ご丁寧にどうもありがとうございました！

回答No.6

Wendy02

こんばんは。#3です。

別に、FileSearch にこだわらなければ、Dir() でよいのです。
FileSearch は、昔から、バグっぽかったし、未だに調子が良くないです。

もともと、FileSearch 　のファイル名のプロパティは、*FILENAME* というワイルドカードがくっついていることと同じだから、片方に、明示的に入れて上げれば、片方は取れます。しかし、そうでないのでしたら、以下のようなものにすればよいです。おそらく、こちらのほうが数段速いはずです。

'--------------------------------------------------
Sub FileSeachPrc()
　Dim Fso As Object
　Dim objFolder As Object
　Dim buf() As Variant
　Dim f As Variant
　Dim i As Long
　Dim j As Integer
　Dim flg As Boolean

　Const MYFILE As String = "PROFILE.xls"
　Const MYDRIVE As String = "A:\" '必ず、末尾に'\'を入れてください。

　'ドライブのReady チェック
　Set Fso = CreateObject("Scripting.FilesystemObject")
　'以下は変数が利かないので、リテラル値 "A"
　If Fso.Drives("A").IsReady = False Then
　　MsgBox "ドライブ" & MYDRIVE & "は、準備されていません。", vbInformation
　　Set Fso = Nothing
　　Exit Sub
　End If

　Set objFolder = Fso.GetFolder(MYDRIVE)
　ReDim buf(0)
　buf(0) = MYDRIVE
　'サブフォルダを格納
　For Each f In objFolder.SubFolders
　　i = i + 1
　　ReDim Preserve buf(i)
　　buf(i) = f
　Next f

　For Each f In buf
　　If Dir(f & "\" & MYFILE) <> "" Then
　　　MsgBox "Aドライブの[" & f & "\" & MYFILE & "]をあった", vbInformation
　　　flg = True
　　　 'あまりに、同名ファイルが多すぎるときの保護
　　　If j > 5 Then Exit For
　　　j = j + 1
　　End If
　Next f

　If flg = False Then
　　MsgBox "Aドライブに[" & MYFILE & "]を保存してね", vbInformation
　End If

　Set Fso = Nothing
　Set objFolder = Nothing
End Sub

お礼

fileSearchに特にこだわりはありませんです。
（使ったことがなかったので色々調べてみたら書いてあったので使ったという安易な理由です…）
DIRでもこのように使えば全然OKなんですね、確かに早いです！
ご丁寧にありがとうございました！

回答No.4

nishi6

少し書き込んでみました。

●問題点１
FileSearchでは、*PROFILE.xls も見つかってしまう。（仕様だと思うが。。。）
●問題点２
FileSearchでは、複数のファイルが見つかることを想定している。（質問は都合で、最初のファイルのみを表示されているのかもしれません）
●問題点３
サブフォルダも検索する指定なので、見つかったファイル名を直接照合するとおかしな結果になる。

下では、
●問題点１：複数のファイルの完全一致を調べている。
●問題点２：完全一致を調べるためにフォルダ名を除いている。
●問題点３：サブフォルダも調べるはずですが、ここにあったとして、どのような処理にするかは分からないので、何もしていません。

Sub Test_1()
　　Dim i As Integer　'// カウンタ
　　Dim checkFileExist As Boolean　'// ファイルがあったか

　　With Application.FileSearch
　　　　.NewSearch
　　　　.LookIn = "A:\"
　　　　.SearchSubFolders = True
　　　　.Filename = "PROFILE.xls"

　　　　'// 見つけたファイルをすべて照合
　　　　checkFileExist = False
　　　　If .Execute() > 0 Then
　　　　　　For i = 1 To .FoundFiles.Count
　　　　　　　　'// ドライブ、フォルダ名を削除して照合
　　　　　　　　'// *PROFILE.xls も見つかるので再チェック
　　　　　　　　checkFileExist = FileExist(.Filename, .FoundFiles(i))
　　　　　　　　If checkFileExist Then
　　　　　　　　　　MsgBox Application.FileSearch.FoundFiles(i) & "あった"
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next
　　　　End If

　　　　If Not checkFileExist Then
　　　　　　MsgBox "Aドライブに[PROFILE.xls]を保存してね"
　　　　End If
　　End With

End Sub

Function FileExist(ByVal schFN As String, ByVal FN As String)
　　Dim p As Integer, pot As Integer

　　'// 一番右の『\』を探す
　　pot = 0
　　For p = Len(FN) To 1 Step -1
　　　　If Mid(FN, p, 1) = "\" Then
　　　　　　pot = p: Exit For
　　　　End If
　　Next

　　'// ファイル名だけで比較
　　FileExist = False
　　If schFN = Right(FN, Len(FN) - pot) Then
　　　　FileExist = True
　　End If
End Function

お礼

ご提示いただいた例でも実現することができました。ご丁寧にご回答ありがとうございました！

回答No.3

Wendy02

こんばんは。

今試してみました。あまり軽率に言うのはいけないのですが、FileSearch は、どうやら、バグに近いですね。他のメソッドで言う、"LookAt" プロパティがないからですね。

やむをえないのですが、FileSearch のまま使うのでしたら、以下のように、ファイル名の後ろをワイルドカードにして、FileType をOffice 用にしてみてください。

　.Filename = "PROFILE.xls*"
　.FileType = msoFileTypeOfficeFiles

なお、.MatchTextExactly = True　では、バージョンによって違うのかもしれませんが、うまくいかないように思います。

お礼

ご回答ありがとうございました！
事情により検索するファイルがCSVになるかもしれないのですが、拡張子の後にワイルドカードをつけたら、.csvでも.xlsでもできました！
でもなぜ「*」をつけるだけでいとも簡単に成功したのでしょうか？？

回答No.2

ja7awu

ヘルプで　MatchTextExactly プロパティ　を調べてみるといいと思います。

お礼

ご回答ありがとうございました。
このようなプロパティがあるとは知りませんでした。

回答No.1

mojonbo

>.Filename = "PROFILE.xls"
この箇所を
.Filename = "\PROFILE.xls"
ではどうでしょうか？
動作未確認ですが・・・

お礼

素早いご回答ありがとうございます！
早速試してみました。
aaaPROFILE.xlsはひっかからなくなりましたが、肝心のPROFILE.xlsもひっかかりませんでした…。