FileSearchがExcel2010でできない

質問

• Excel2003ではできたFileSearchがExcel2010ではエラーになる問題について質問です。
• Excel2010でExcel2003と同じような動作をする方法を知りたいです。
• Userform1のチェックボックスを選択するとファイルが検索される仕様になっていますが、Excel2010で使用する方法を教えてください。

回答No.2

end-u

ver2007以降、Application.FileSearchオブジェクトはサポートされていません。
http://support.microsoft.com/kb/920229/ja
代替手法でのコーディングが必要です。
以下、コマンドプロンプトのDIRコマンドを使う例。

Private Sub CommandButton1_Click()
　Dim fso As Object
　Dim drv As String
　Dim buf As String
　Dim tmp As String
　Dim wrk As String
　Dim r　 As Range
　Dim x　 As Long
　Dim n　 As Long
　Dim a　 As Long
　Dim i　 As Long
　Dim cnt As Long
　Dim v

　For x = 1 To 17
　　If Me.Controls("CheckBox" & x) = True Then Exit For 'チェックしてあるかを確認
　Next
　If x = 18 Then Exit Sub

　buf = InputBox("検索したいファイル名を入力してください" & vbCrLf & _
　　　　　　　　 "ただし、複数キーワード検索はできません" & vbCrLf & _
　　　　　　　　 "キーワード入力後、「ＯＫ」ボタンを選択", "キーワード入力")
　If buf = "" Or buf = "False" Then Exit Sub

　Set fso = CreateObject("Scripting.FileSystemObject")
　wrk = Application.DefaultFilePath & "\temp" & CLng(Date) & ".txt"
　For x = 1 To 17
　　If Me.Controls("CheckBox" & x) = True Then
　　　drv = Chr(Asc("J") + x - 1)
　　　tmp = "dir """ & drv & ":\*" & buf & "*"" /b/s"
　　　CreateObject("WScript.Shell") _
　　　　　　　.Run "%ComSpec% /c " & tmp & ">""" & wrk & """", 0, True

　　　n = FreeFile
　　　Open wrk For Input As #n
　　　v = Split(StrConv(InputB(LOF(n), #n), vbUnicode), vbCrLf)
　　　Close #n
　　　cnt = UBound(v)

　　　With Sheets(x + 1)
　　　　.Visible = True
　　　　If cnt > 0 Then
　　　　　MsgBox "ドライブ " & drv & " に " & cnt & _
　　　　　　　　 " 個のファイルが見つかりました", vbOKOnly, "検索結果"
　　　　　Application.ScreenUpdating = False
　　　　　a = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
　　　　　For i = 0 To cnt - 1
　　　　　　Set r = .Cells(a + i, 2)
　　　　　　With fso.getfile(v(i))
　　　　　　　r.Value = i + 1
　　　　　　　r.Offset(, 1).Value = .Name
　　　　　　　r.Offset(, 2).Value = .DateLastModified
　　　　　　　r.Worksheet.Hyperlinks.Add Anchor:=r.Offset(, 1), _
　　　　　　　　　　　　　　　　　　　　 Address:=.Path
　　　　　　End With
　　　　　　Set r = Nothing
　　　　　Next
　　　　Else
　　　　　MsgBox "ドライブ " & drv & " 見つかりませんでした"
　　　　　.Visible = False
　　　　End If
　　　End With
　　End If
　Next

　Kill wrk
　Set fso = Nothing
　Unload Me 'UserForm1
End Sub

お礼

ありがとうございます。
検索結果によってWith fso.getfile(v(i))やIf Me.Controls("CheckBox" & x) = True Thenの所でエラーが出ます。
ほとんどが前者のエラーが出ます。たまに後者のエラーも出るので統一性がわかりません。
検索結果数はきちんと出ますが、別シートに検索結果が表示されません。
もしよろしければ、こちらの方もお時間ありましたらお願いします。