Excel2007で、ディレクトリ付きファイル一覧をシート出力するマクロ

質問

Excel2003で、以下のソースを使い、シート上にディレクトリ付きファイル一覧を作成していたのですが、Excel2007では使えなくなりました。代替方法はありませんか？

Sheets("Sheet10").Range("A1:Z6000").Clear
With Application.FileSearch
.newSearch
.LookIn = "C:\works"
.filename = "*.html"
.SearchSubFolders = True
Sheets("Sheet10").Select
CSVMAX = .FoundFiles.Count
For result = 1 To CSVMAX
Sheets("Sheet10").Cells(result, 1) = .FoundFiles(result)
Next
End With

回答No.3

imogasi · ベストアンサー

２００７ではFileSearchは使えなくなったようだ。
質問を少し修正して、２００２，３では下記で動くと思う。
Sub test01()
Sheets("Sheet4").Range("A1:Z6000").Clear
With Application.FileSearch
.NewSearch
.LookIn = "C:\Documents and Settings\OTO\My Documents\"
.Filename = "*.html"
.SearchSubFolders = True
Sheets("Sheet4").Select
If .Execute() <> 0 Then
csvMAX = .FoundFiles.Count
MsgBox csvMAX
For result = 1 To csvMAX
Sheets("Sheet4").Cells(result, 1) = .FoundFiles(result)
Next
End If
End With

End Sub
でやると、２００７ではないですが、うまく行きました（*.doc,*.xls,*.htmlで）。
If .Execute() <> 0 Then
・・・
End If
を加えただけです。
ーー
参照設定が「Microsoft Office 8.0 Object Library」
８　　　　９７
９　　２０００
１０　２００２
１１　２００３
１２　２００７
９７以後FileSearchは有ると思う。
＝＝＝＝＝＝
２００７でもなくなって居ないと思うが、不確か。

実は調べてみると
http://www.kotaete-net.net/Default.aspx?pgid=14&qid=140502861177
に在った。使えなくなったようだ。
ーー
DIR
FSO
でやってみてください。

お礼

ありがとうございました。
暫定手段として、DOSのdirコマンドで外部ファイル出力したものを
Excelに取り込むようにしてました。
参考にします。

回答No.2

mitarashi

FileSystemObjectならExcel2007でも使えますので、こちらをお使いになってはいかがでしょうか。下記サイトで勉強すれば、直ぐに使えると思います。
http://officetanaka.net/excel/vba/filesystemobject/filesystemobject.htm

お礼

ありがとうございました。参考にします。

回答No.1

end-u

DIRコマンドを使うサンプルです。
Sub test1()
　　Const arg = "dir ""c:\works\*.txt"" /b/s"
　　Dim ret As String
　　Dim v() As String

　　ret = CreateObject("WScript.Shell").Exec("%ComSpec% /c " & arg).StdOut.ReadAll
　　v = Split(ret, vbCrLf)
　　Sheets.Add.Cells(1).Resize(UBound(v) + 1).Value = Application.Transpose(v)
End Sub

コンソールウィンドウを出したくないならファイルに一旦出力して取り込みます。
Sub test2()
　　Const arg = "dir ""c:\works\*.txt"" /b/s"
　　Const wrk = "c:\output.txt" '出力用。上書きしますので既存ファイルに注意。
　　Dim v() As String
　　Dim n　 As Long

　　CreateObject("WScript.Shell").Run "%ComSpec% /c " & arg & ">" & wrk, 0, True
　　n = FreeFile
　　Open wrk For Input As #n
　　v = Split(StrConv(InputB(LOF(n), #n), vbUnicode), vbCrLf)
　　Close #n
　　Sheets.Add.Cells(1).Resize(UBound(v) + 1).Value = Application.Transpose(v)
End Sub

お礼

ありがとうございました。参考にします。