FileSearchがExcel2007で使えなくなったことへの対応方法は?

Question 83.3 Previous Next
ExcelVBAマクロ500連発―すぐに使える実用パーツ集〈第2弾〉 」の340番につきまして、
win32apiの方ではなく、FileSearchとExcel2007の問題で対策を教えていただきたく投稿しました。
これをそっくり利用して、写真ファイルを探させ、その写真ファイルを所定の写真台紙に貼り込むプログラムを社内に配布し、充分使用に耐えているもがあります。
エラーは、まずはExcel2007(OSはVista)ではFileSearchが使えないことによるもので、このためシートに写真リストを書き込むことができません。
できればExcelバージョンに関係なく共通で使えるように組替えたいのですが、ご教示いただければ幸いです。
(※まだまだこの先のエラーの方が大変かもしれません・・・。)
Answer   Copyright (C) 2007.7.23 永井善王
ExcelVBAマクロ500連発―すぐに使える実用パーツ集〈第2弾〉 をご愛読、ありがとうございます。
340番は「指定フォルダー内の全ファイル名を取得する」と題する遠山文雄氏の作品です。
その機能は、表示されたユーザーフォームを操作してフォルダーを選択すると、そのフォルダーとサブフォルダーの中から指定された拡張子のファイルを探して、そのファイル名をリストボックスへ表示してくれます。
ご質問が、監修者である私宛に寄せられましたので、お答えします。

FileSearchオブジェクトは仰るとおり、Excel2007では動作しなくなりました。
あなたのご希望が「Excelバージョンに関係なく共通で使えるように組替えたい」ということで尤もなことですが、私は、この機能ならMS社が、将来も絶対に廃止しないと保証できる立場にはありません。
よって、代替策としては色々な方法が考えられますが、オーソドックスな方法を中心にしてご紹介しておきます。

1. 「フォルダー内のファイル名を取得する」というマクロを流用する方法
左図の「Excel VBA そのまま使える実用マクロ500連発」のサンプルNo.012に、「フォルダー内のファイル名を取得する」と題するマクロがあります。
コードは下記のとおりで、伝統的な Dir関数を利用しています。 Dir関数は、指定したパターンやファイル属性と一致するファイルまたはフォルダーの名前を表す文字列型 (String) の値を返してくれます。
このマクロは、サブフォルダーに対しては処理されません。
Sub フォルダー内のファイル名を取得する()
    フォルダーパス = ActiveWorkbook.Path          'パスを取得
    ファイル名 = Dir(フォルダーパス & "\*.*")     'ファイル名を取得
    貼付行 = 9 - 1                              '貼付行ポインタを初期化

    Do While ファイル名 <> ""                   '取り出したファイル名がヌルでなければ
        貼付行 = 貼付行 + 1                     '貼付行ポインタを上げる
        If 貼付行 <= 13 Then
            Range("P" & 貼付行).Value = ファイル名 'セルにファイル名をセット
        End If
        ファイル名 = Dir()                      '次のファイル名を取り出す
    Loop
End Sub
2. 「指定フォルダー内の全てのブックを順に開く」というマクロを流用する方法
サブフォルダーに対しても処理したい場合は、拙著「 ExcelVBAマクロ組み方講座―Excel97/98/2000/2001/2002/v.X対応 」のP.128~142に掲載されている表題のマクロを流用する方法が考えられます。
このマクロも Dir関数を利用していますが長いので、ここで内容をお示しすることはできませんが、各地の図書館の蔵書にあるようですので、見ていただくことが可能と思います。

3. FileSearchを使わないサンプル(条件に該当するものをシートに表示)
私の友人である井上 治氏のホームページ「
Excelでお仕事 - ファイルの検索 」でご覧ください。

では、ご成功を祈ります。 結果をお知らせください。

 

Excel VBA Macro