[[20150321182359]]　『フォルダ内のエクセルブックのプロパティ取得』（スーパービギナー）　ページの最後に飛ぶ

『フォルダ内のエクセルブックのプロパティ取得』（スーパービギナー）

こんにちは。

次のことをＶＢＡでできないかと考えています。
ＶＢＡは始めたばかりでわからないことばかりなので、助けて頂けると嬉しいです。

<やりたいこと>
フォルダ内にある複数のエクセルブックのプロパティとそのファイル名・パスを
シート上に一覧にして出力したい。

細かいところを言いますと
１．いくつかの必要な項目だけを出力したい。
２．対象のブックを開かずにデータを取得したい。
３．ＯＳやエクセルのバージョンによらず動かしたい。

参考になるサイトをいろいろ探してはいるのですが、なかなか上の仕様に合うものが見つかりません。
カリーニンさんに教えて頂いた下記のページにある内容は、やりたいことはそのもの
なのですが、ＯＳによってコードが変わってしまうので上の条件に合いませんでした。
また、コードの内容もよくわからず動かせない状況です。
http://officetanaka.net/excel/vba/tips/tips122.htm

もし上記の内容に合うコードをご存知でしたら教えて頂けないでしょうか。
全く合わなくてもヒントを頂けますと助かります。

どうぞよろしくお願いいたします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 こんばんは

　下記サイトが参考になると思います。

 http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_010_030.html

（大江戸） 2015/03/21(土) 19:06

 田中さんのサイトの説明と、大江戸さんから紹介のあった井上さんのサイトをあわせれば完璧に わかりませんか？

 ・まず、ブックを開かず・・・　なぜですか？
 　目的の情報が得られれば開こうがひらくまいが、どっちでもいいでしょ？

 ・ＯＳによってコードが変わってしまうので上の条件に合いませんでした。

 　それは、コードの書き方次第ですよ。田中さんのサイトの説明をよく読んでください。

 •20 → 作成者 
 •21 → タイトル 
 •22 → サブタイトル

 　あるいは

 •9 → 作成者 
 •10 → タイトル 
 •11 → サブタイトル

 でしょ。　であれば 9 か 20 が作成者、10 か 21 がタイトル、11 か 22 がサブタイトル

 こういったロジックにすればいいのでは？

 あるいは、井上さんのサイトにあるように、インデックスで取得した情報の中の　プロパティ名で判断するということもできます。

 「細かいところを言いますと」
 「１．いくつかの必要な項目だけを出力したい。 」

 ちっとも、細かくないんですが？
 細かく説明をされるなら、この項目とこの項目とこの項目と・・・・

 でしょ？
 それに、これも、コードで、必要な項目だけを相手にすればいいだけのことでしょ？

 まさか、自分は、あれとこれと。。５つの項目のみを相手にしたい。
 その５つの項目だけを相手にしているサイトがない・・そんなことを言ってます？

（β） 2015/03/21(土) 19:35

大江戸さん
ありがとうございます！参考にさせていただきます。
ただネックなのがやはりフォルダを開いているという点です。

βさんの質問にもありましたが、フォルダを開かずというのは
プロパティの取得速度をできるだけ早くしたいからです。
１０ＭＢ近くあるファイルも存在するので、すべて開いてしまうと
かなり時間が掛かってしまいます。ですので、フォルダを開かずという
条件を設定しました。

ＯＳによってコードが変わってしまうので条件に合わないと言っていた件に関しましては、
βさんが言われるようなORのロジックを組むことは思いつきませんでした。
ただ、例えば「9か20が作成者」とした場合に、windows XPで20に別の項目が当てられている
場合はそのようなロジックは不可能だと思うのですが、いかがでしょうか。

インデックスで取得した情報のプロパティ名で判断というのは、まだ理解ができて
おらず、もう少し田中さんのサイトを読んでみます。

項目に関しては、全部の項目は出力したくないが、まだどの項目を出力するか確定していない
ので、ああいった曖昧な言い方になってしまいました。わかりにくくて申し訳ありませんでした。

全体的に質問の仕方が悪かったと反省しています。
お気を悪くさせてしまい申し訳ありませんでした。
（スーパービギナー） 2015/03/21(土) 22:40

 一度に最後までを目指さないで、まずは取得した一連の OS環境で一つの特定の
 プロパティを取得するところまでを目指してはどうでしょうか。

 それができれば、数を増やすのは難しくないと思います。

 >ただ、例えば「9か20が作成者」とした場合に、windows XPで20に別の項目が当てられている
 >場合はそのようなロジックは不可能だと思うのですが、いかがでしょうか。

 それに関してはβさんが、
 >あるいは、井上さんのサイトにあるように、インデックスで取得した情報の中の　プロパティ名で判断するということもできます。
 というコメントをされていますし、OS を判断して処理を分岐するということもできます。

（Mook） 2015/03/21(土) 22:48

Mookさん

アドバイスありがとうございます。
一旦、田中さんのＨＰにあるコードで、一つのファイルを対象に試しています。

知っておられたら教えて頂きたいのですが、
田中さんのＨＰにあるsample9のコードはどういったコードなのでしょうか。
GetDetailsOfメソッドの引数に指定する数値に関して、何番がどの項目かがわかる
とありますが、このコードを実行すると項目と番号が表示されるのでしょうか。
（実行してみましたが、何も起こりませんでした...。）

よろしくお願いいたします。
（スーパービギナー） 2015/03/21(土) 23:59

 参考ＨＰです。

http://excelvba.pc-users.net/fol8/8_1.html
（カリーニン） 2015/03/22(日) 00:13

カリーニンさん
ありがとうございます！そんな機能もあるんですね。

確認してみますと、ブックのプロパティの下記の項目が見当たらないのですが
数値が割り当てられていないということはあるのでしょうか。

１．テンプレート
２．更新者
３．アプリケーション名
４．形式
５．管理者
６．ハイパーリンクの基点

上記の項目を出力したいと思っています。

よろしくお願いします。

（スーパービギナー） 2015/03/22(日) 01:58

 少しきつい言い方をしましたが、一足飛びにたどりつこうとせず、一歩ずつトライしてほしいなぁと思いましたので。

 >ただ、例えば「9か20が作成者」とした場合に、windows XPで20に別の項目が当てられている 
 >場合はそのようなロジックは不可能だと思うのですが、いかがでしょうか。

 確かにそうです。で、そんなときは【推測】せず、ネット検索等で調べる。
 調べられなければ自分で試してみる。そんなアプローチが（今後、何をするにしても）必要ですね。

 自分で試してみるサンプルです。
 （当方、XP環境がないので、逆に  XP で20 はどうだったかな？と興味がありますので結果を教えていただければ幸甚）

 新規ブックに以下のマクロをコピペして、いったん名前を付けて保存してください。
 で、これを、各OS環境で動かしてください。

 A1 に　調べたい番号を入れてください。
 B1 に　プロパティ名、C1 に番号で指定したそのプロパティの値、D1 にプロパティ名で指定したその値を表示します。

 Sub Test()
    Dim idx As Long
    Dim dValue1 As Variant
    Dim dValue2 As Variant
    Dim dName As String

    With ThisWorkbook
        On Error Resume Next
        dName = "参照不能"
        dValue1 = "参照不能"
        dValue2 = "参照不能"
        idx = Val(Range("A1").Value)
        'プロパティ名
        dName = .BuiltinDocumentProperties(idx).Name
        'インデックスによる取得
        dValue1 = .BuiltinDocumentProperties(idx).Value
        '名前による取得
        dValue2 = .BuiltinDocumentProperties(dName).Value
        On Error GoTo 0

        Range("B1").Value = dName
        Range("C1").Value = dValue1
        Range("D1").Value = dValue2

    End With
 End Sub

（β） 2015/03/22(日) 06:35

 >そんな機能もあるんですね。

 βさんご指摘のことと重なりますが、「sample9」の記述の
 量はさほど多くないので記述をヘルプやネット検索したら
 何も起こらないようにみえる原因が「Debug.Print」だと
 直ぐに分かったこととおもいます。

 自分自身で調べることも実力アップの秘訣です。
（カリーニン） 2015/03/22(日) 07:55

 >確認してみますと、ブックのプロパティの下記の項目が見当たらないのですが 
 >数値が割り当てられていないということはあるのでしょうか。

 βがアップした確認マクロで、１，７，９，１９、２０，２９　をそれぞれいれて実行してみてください。

（β） 2015/03/22(日) 15:43

βさん
仰る通りです。時間がなく、すぐに最終的な答えを求めようとしていました。
一つ一つクリアしていこうと思います。

βさんに頂いたマクロでそれぞれの番号を実行してみましたら各項目が表示されました。

ただ、この番号を田中さんのＨＰのsample8に適用しようとすると、別の項目の情報が
出力されてしまいます。

プロパティの番号とGetDetailsOfメソッドの引数に指定する数値は違うものなのでしょうか。
（スーパービギナー） 2015/03/22(日) 18:41

 Sample8の解説に

 >GetDetailsOfメソッドの引数に指定する数値は、OSによって異なりますので注意が必要です

 とありますが、そこは確認されてますか？
（カリーニン） 2015/03/22(日) 19:10

カリーニンさん

それは確認しています。

実際田中さんのHPのsample9で確認した数値をβさんに頂いたマクロで項目を確認したところ
違う項目が出力されたので上記のような質問をしています。

（スーパービギナー） 2015/03/22(日) 23:17

 GetDetailOf は GetDetailOf で、BuiltinDocumentProperties　とは別物ですよね？
 両者のインデックスが同じだということは、どこにも書かれていないですよ？

https://msdn.microsoft.com/en-us/library/windows/desktop/bb787870(v=vs.85).aspx

 GetDeailOf のほうは、BuiltinDocumentProperties　とは全く異なるインデックスで、６種類しかないですね。

 ちなみにBuiltinDocumentPropertiesは

https://msdn.microsoft.com/ja-jp/library/microsoft.office.tools.excel.workbook.builtindocumentproperties.aspx

 各項目のインデックスは上から順に 1,2,3,・・・・　です。

 ところで、アップした確認コード、A1にいれて、マクロ実行が、まだるっこしいのでシートモジュールに
 おいてみました。

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim idx As Long
    Dim dValue1 As Variant
    Dim dValue2 As Variant
    Dim dName As String

    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    Application.EnableEvents = False

    With ThisWorkbook
        On Error Resume Next
        dName = "参照不能"
        dValue1 = "参照不能"
        dValue2 = "参照不能"
        idx = Val(Range("A1").Value)
        'プロパティ名
        dName = .BuiltinDocumentProperties(idx).Name
        'インデックスによる取得
        dValue1 = .BuiltinDocumentProperties(idx).Value
        '名前による取得
        dValue2 = .BuiltinDocumentProperties(dName).Value
        On Error GoTo 0

        Range("B1").Value = dName
        Range("C1").Value = dValue1
        Range("D1").Value = dValue2

    End With

    Application.EnableEvents = True

 End Sub

（β） 2015/03/23(月) 06:53

Sample8で、例えば以下のようにすれば、ファイル名が得られることを説明していますよね。
（ファイル名を指定してファイル名を得る、というのは意味ありませんが…）

        Cells(cnt, 1) = Folder.GetDetailsOf(Folder.ParseName(Target), 0)

このとき、末尾の0が、ファイル名を得る意味になります。20なら作成者が得られます。
指定できる数字と情報の対応表を一覧表示してくれるのが、Sample9になります。
結果はイミディエイトウィンドウに表示されるので、マクロ編集画面で表示されていなければ、CTRL+Gを押してみてください。

ちなみに、こちらのコードで得られる情報は、Excelブックのプロパティではなく、ファイルのプロパティです。
ブックのプロパティは、ブックを開かないと判りません。
（ブックをファイルとして開く手もありますが、開く事には変わりありませんし）
（???） 2015/03/23(月) 09:16

 (???)さんからもコメントありますが、ブックを開かずに取得できる情報は GetDetailOf で取得できる６つの情報、
 あるいは FSO の GetFileメソッドで得られる　Fileオブジェクトのプロパティのいくつか（ほとんど、GetDetailOf　で得られるものと重なっていますが）

 あとはブックを開いて、BuiltinDocumentProperties　から取得せざるを得ませんね。

 で、（スーパービギナー）さんがほしい情報は、残念ながら　BuiltinDocumentProperties　のものばかりですね。

 追記　19:40

 ↑　とかいたあと、ふと思いついて。
 実際に開くのと、どれぐらい時間が短縮されるのか、かわらないのか、計測はしていませんが。

 一応、見た目、開かれていませんが、BuiltinDocumentProperties　の参照ができます。

 Sub Test()
    Dim fPath As String
    Dim wb As Workbook

    fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\Testz\data1.xlsx"
    Set wb = GetObject(fPath)
    MsgBox wb.Name
    MsgBox wb.BuiltinDocumentProperties(3).Name & vbLf & wb.BuiltinDocumentProperties(3).Value
    Set wb = Nothing

 End Sub

（β） 2015/03/23(月) 17:51

 ↑　ブックを１０個ぐらいで試してみましたら、Application.ScreenUpdating = False にして実際に開くほうが
 　　ほんのわずかですが早かったですね。

 GetObjectのほうは 2秒強、Workbooks.Open なら 1.6秒ぐらいでした。

（β） 2015/03/23(月) 20:35

レスポンスが遅くて申し訳ありません。
βさんの仰られるようにファイルを開いた方が取得できる項目も欲しい項目とマッチしますし、
コードもわかりやすいのですが、まずは開かない方向で進めたいと思っています。
（時間まで測って頂いたのにすみません...。）

GetDetailsOfの方で試してみて、項目は限られるのですがやりたい動作は確認できました。

ただ、以前にも懸念してましたＯＳの違いによるインデックスの違いに対する対策で躓いています。

以前にアドバイス頂いた、ＯＳを判別して取得したいインデックスを選択するという方法が
良いと思っているのですが、コードがうまく書けません。

やりたいことは、
現在、田中さんのＨＰのsample8の方法でプロパティを取得しています。
http://officetanaka.net/excel/vba/tips/tips122.htm

その中の
Cells(cnt, 1) = Folder.GetDetailsOf(Folder.ParseName(Target), 0) ''ファイル名
の"0"のところをＯＳによって変えられるようにしたいです。
例えば、windows7なら"0"、XPなら"10"の項目を取得するといった感じで。

どのようにコードを書けばいいか教えて頂けると助かります。
よろしくお願い致します。

（スーパービギナー） 2015/04/02(木) 08:42

Sample9で、指定できる数値と意味を列挙していましたよね。
これを応用して、目的の文字列と一致するかを比較。一致した番号を使えば良いかと。
（???） 2015/04/02(木) 09:06

 ネットを検索すればいくらでもでてくると思いますが、たとえば

http://www.moug.net/tech/exvba/0150124.html

 Application.OperatingSystem での取得と、WMI　で取得する例が掲載されています。

 ただ、当方の Win7とWin8.1、いずれも OS は 64Bit なんですが、Application.OperatingSystem では
 いずれも、"32Bit" と返ってきたことが　？？　ではあります。
 OSバージョンはもちろん正しく返りますが。

（β） 2015/04/02(木) 09:23

 βさん、Excelのほうは32Bit版、64Bit版どちらだろうか？

 もしかしたらExcelも64Bit版でないと"64Bit"と返ってこない可能性があるが。
 (手元の64BitOSに入っているExcelは32Bit版のため未確認)
（ねむねむ） 2015/04/02(木) 09:53

 To ねむねむさん

 はい。そうだとおもいます。
 当方のOfficeは32Bit版で、Application.なんたら　は、あくまで　エクセルからみたものということでしょうから
 32BitOSの機能下で動作する、だから 32Bit と表現されるんだろうなと推測しています。

 ただ、これを見て、あぁ、自分のＰＣは32BitＯＳ　だったんだと誤解する人もいるかもしれませんねぇ。

 To スーパービギナーさん

 アップした後、ふと。

 >Cells(cnt, 1) = Folder.GetDetailsOf(Folder.ParseName(Target), 0) ''ファイル名 
 >の"0"のところをＯＳによって変えられるようにしたいです。

 この意味を、ＯＳを把握したいというふうに受け取ったんですが、ＯＳは把握済み。
 0 のところを変数で与えられないかということだったでしょうか？
 それならそれで、いろんな方法がありますけど。

（β） 2015/04/02(木) 10:01

ちなみに、今これを書いているPCはWINDOWS7(32bit)ですが、ClassicShellというのをインストールし、エクスプローラ等をちょっと変えているんです。
すると、GetDetailsOfでファイル名が得られる番号は、0ではなく、155だったりします。

OSというより、シェルで変わってしまうので、OSバージョンを得るだけでは汎用性は低いと思います。
（???） 2015/04/02(木) 10:24

 To (???)さん

 あぁ、なるほど。GetDetailsOf が取得する情報元は、そこ（エクスプローラの構成）だったんですね。
 勉強になりました。

（β） 2015/04/02(木) 10:48

βさん

 >Cells(cnt, 1) = Folder.GetDetailsOf(Folder.ParseName(Target), 0) ''ファイル名 
 >の"0"のところをＯＳによって変えられるようにしたいです。

この意味は、OSを把握し、かつ0のところを変数で与えられないかということです。

ですので、OSを把握した後、
Cells(cnt, 1) = Folder.GetDetailsOf(Folder.ParseName(Target), 0(winndows7の場合) or 10(windowsXPの場合)) ''ファイル名
といった構文にする。もしくは

windows7の場合
Cells(cnt, 1) = Folder.GetDetailsOf(Folder.ParseName(Target), 0) ''ファイル名

windowsXPの場合
Cells(cnt, 1) = Folder.GetDetailsOf(Folder.ParseName(Target), 10) ''ファイル名
といった構文をイメージしています。

このようなことは可能でしょうか。

???さん
そうなんですね…。
今はとりあえずＯＳバージョンだけで最低限取得できるところまで行こうと思ってます。
（スーパービギナー） 2015/04/02(木) 18:40

 以下は参考コードです。
 対象にしたいＯＳは適宜追加してください。

 'Windows 8.1→  Windows (32-bit) NT 6.02
 'Windows 7 →  Windows (32-bit) NT 6.01
 'Windows Vista → Windows (32-bit) NT 6.00
 'Windows XP → Windows (32-bit) NT 5.01
 'Windows 2000 → Windows (32-bit) NT 5.00
 'Windows Me → Windows (32-bit) 4.90
 'Windows 98 → Windows (32-bit) 4.10
 'Windows 95 → Windows (32-bit) 4.00

 Sub Test()
    Dim ID As Variant
    Dim tmp As Variant

    tmp = Split(Application.OperatingSystem)
    Select Case tmp(UBound(tmp))
        Case "6.01"     'Win7
            ID = 0
        Case "5.01"     'XP
            ID = 10
    End Select

    If Not IsEmpty(ID) Then     '想定ＯＳ以外は処理しない

        MsgBox ID

        'IDを与えて実行
        'たとえば
        'Cells(cnt, 1) = Folder.GetDetailsOf(Folder.ParseName(Target), ID) ''ファイル名
    End If

 End Sub

（β） 2015/04/02(木) 19:02

 >Cells(cnt, 1) = Folder.GetDetailsOf(Folder.ParseName(Target), 0(winndows7の場合) or 10(windowsXPの場合)) ''ファイル名

 この形をお望みなら、たとえば XP は10、それ以外は 0 ということだったとして以下のようなコードでも。

 Sub Test2()
    Dim flag As Boolean
    Dim tmp As Variant

    tmp = Split(Application.OperatingSystem)
    If tmp(UBound(tmp)) = "5.01" Then flag = True 'XP

    'Flagをチェックして実行
    'たとえば
    'Cells(cnt, 1) = Folder.GetDetailsOf(Folder.ParseName(Target), IIF(flag,10,0)) ''ファイル名

 End Sub

（β） 2015/04/03(金) 08:46

OSやシェルのバージョンを気にせず、欲しい項目の番号を得る例。
（Sample9を元にしています）

 Sub test()
    Dim iNo As Variant

    iNo = fGetDetailNo("ファイル名")
    If iNo <> False Then
        MsgBox iNo
    Else
        MsgBox "見つかりません"
    End If
 End Sub

 Function fGetDetailNo(cName As String) As Variant
    Dim Shell As Object
    Dim Folder As Object
    Dim i As Long

    fGetDetailNo = False

    Set Shell = CreateObject("Shell.Application")
    Set Folder = Shell.Namespace("C:\")

    For i = 0 To 300
        If cName = Folder.GetDetailsOf("", i) Then
            fGetDetailNo = i
            Exit For
        End If
    Next i

    Set Folder = Nothing
    Set Shell = Nothing
 End Function
（???） 2015/04/03(金) 10:07

これまでβさんに頂いたコードでプロパティを一覧として出力することができました。
（XPでは確認できていませんが...）

出力したファイル名にハイパーリンクを挿入したく、いろいろ調べて下記のコードで試してみたところ、ファイル名は青色に変わりクリックできるのですが"指定されたファイルを開くことができません。"というエラーが表示されます。

ハイパーリンクのために追加した箇所は25行目のActiveSeet...の文です。
どこをどう改善したらよいでしょうか。教えてください。

Private Sub CommandButton2_Click()

    Dim Shell As Object, Folder As Object, Target As String, cnt As Long
    Dim flag As Boolean
    Dim tmp As Variant
    tmp = Split(Application.OperatingSystem)
    If tmp(UBound(tmp)) = "5.01" Then flag = True 'XP
    Const Path As String = "C:\sample\"
    Set Shell = CreateObject("Shell.Application")
    Set Folder = Shell.Namespace(Path)
    Target = Dir(Path & "*.xls")
    Do While Target <> ""
        cnt = cnt + 1
        Cells(cnt, 2) = Folder.GetDetailsOf(Folder.ParseName(Target), 0)    ''ファイル名
        Cells(cnt, 3) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 12, 23)) ''分類
        Cells(cnt, 4) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 33, 18)) ''キーワード
        Cells(cnt, 5) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 10, 21)) ''タイトル
        Cells(cnt, 6) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 11, 22)) ''サブタイトル
        Cells(cnt, 7) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 35, 33)) ''会社
        Cells(cnt, 8) = Folder.GetDetailsOf(Folder.ParseName(Target), 3)   ''更新日時
        Cells(cnt, 9) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 9, 20)) ''作成者
        Cells(cnt, 10) = Folder.GetDetailsOf(Folder.ParseName(Target), 4)   ''作成日時
        Cells(cnt, 11) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 14, 24)) ''コメント

        ActiveSheet.Hyperlinks.Add anchor:=Cells(cnt, 2), Address:="C:\sample\" & Cells(cnt, 2).Value & ".xls"

        Target = Dir()

    Loop

    Set Folder = Nothing
    Set Shell = Nothing

End Sub

よろしくお願いします。
（スーパービギナー） 2015/04/09(木) 18:44

 & ".xls"
 が余計なのではないでしょうか？
（Mook） 2015/04/09(木) 21:07

Mookさん

ご指摘通り & ".xls"を削除するとファイルが開けました！
ありがとうございます！
（スーパービギナー） 2015/04/09(木) 21:16

PCによって実行できる場合とエラーが出る場合があって、調べてはいるのですが
よい対策が見つからず助けて頂けないでしょうか。

実行できる環境：windows8.1(64bit)　EXCEL2010　
エラーの出る環境：windows7(32bit)　EXCEL2010

エラーは
　「実行エラー'52':　ファイル名または番号が不正です。」
というエラーです。

指摘箇所は
　Target = Dir(Path & "*.xls")
です。

何か考えられる原因等がありましたらご教授頂ければ幸いです。
宜しくお願い致します。

全コードは以下になります。
Private Sub CommandButton2_Click()

    Dim Shell As Object, Folder As Object, Target As String, cnt As Long
    Dim flag As Boolean
    Dim tmp As Variant
    tmp = Split(Application.OperatingSystem)
    If tmp(UBound(tmp)) = "5.01" Then flag = True 'XP
    Const Path As String = "C:\sample\"
    Set Shell = CreateObject("Shell.Application")
    Set Folder = Shell.Namespace(Path)
    Target = Dir(Path & "*.xls")
    Do While Target <> ""
        cnt = cnt + 1
        Cells(cnt, 2) = Folder.GetDetailsOf(Folder.ParseName(Target), 0)    ''ファイル名
        Cells(cnt, 3) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 12, 23)) ''分類
        Cells(cnt, 4) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 33, 18)) ''キーワード
        Cells(cnt, 5) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 10, 21)) ''タイトル
        Cells(cnt, 6) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 11, 22)) ''サブタイトル
        Cells(cnt, 7) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 35, 33)) ''会社
        Cells(cnt, 8) = Folder.GetDetailsOf(Folder.ParseName(Target), 3)   ''更新日時
        Cells(cnt, 9) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 9, 20)) ''作成者
        Cells(cnt, 10) = Folder.GetDetailsOf(Folder.ParseName(Target), 4)   ''作成日時
        Cells(cnt, 11) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 14, 24)) ''コメント
        ActiveSheet.Hyperlinks.Add anchor:=Cells(cnt, 2), Address:="C:\sample\" & Cells(cnt, 2).Value
        Target = Dir()
    Loop
    Set Folder = Nothing
    Set Shell = Nothing
End Sub
（スーパービギナー） 2015/04/14(火) 18:44

解決しました！

問題は、指定したフォルダが存在しないフォルダだったためエラーが出ていたようです。
単なるミスでした・・・。

（スーパービギナー） 2015/04/14(火) 18:50

こんばんは。

上記のコードでは、単一フォルダのエクセルのプロパティを一覧で出力するというものですが、
単一フォルダではなく、指定したフォルダにあるファイルとその指定フォルダ内にあるサブフォルダ
内のファイルを読みだすにはどうしたら良いでしょうか。

対象は指定フォルダ内のサブフォルダまでとし、サブフォルダ内のサブフォルダ以下のファイルは
対象外としたいと思っています。

サブフォルダまで呼び出すにはFilesystemObjectを使えば良さそうということはわかったのですが...。
今回のコードの場合の使い方がいまいちわかりません。

アドバイス頂けると幸いです。
よろしくお願いいたします。
（スーパービギナー） 2015/04/15(水) 00:12

 もう少しコードを整理できそうですが、とりあえず一例です。

Private Sub CommandButton2_Click()

    Const Path As String = "C:\sample\"

    Dim fso As Object
    Dim pFold As Object
    Dim sFold As Object
    Dim fold As Object
    Dim f As Object

    Dim Shell As Object, Folder As Object, Target As String, cnt As Long
    Dim flag As Boolean
    Dim tmp As Variant

    tmp = Split(Application.OperatingSystem)
    If tmp(UBound(tmp)) = "5.01" Then flag = True 'XP
    Set Shell = CreateObject("Shell.Application")
    Set Folder = Shell.Namespace(Path)

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set pFold = fso.getfolder(Path)
    Set fold = pFold

    GoSub printinfo

    For Each fold In pFold.SubFolders
        Set Folder = Shell.Namespace(fold.Path)
        GoSub printinfo
    Next

    Set Folder = Nothing
    Set Shell = Nothing

    Exit Sub

printinfo:

    For Each f In fold.Files
        Target = f.Name
        cnt = cnt + 1
        Cells(cnt, 2) = Folder.GetDetailsOf(Folder.ParseName(Target), 0)    ''ファイル名
        Cells(cnt, 3) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 12, 23)) ''分類
        Cells(cnt, 4) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 33, 18)) ''キーワード
        Cells(cnt, 5) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 10, 21)) ''タイトル
        Cells(cnt, 6) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 11, 22)) ''サブタイトル
        Cells(cnt, 7) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 35, 33)) ''会社
        Cells(cnt, 8) = Folder.GetDetailsOf(Folder.ParseName(Target), 3)   ''更新日時
        Cells(cnt, 9) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 9, 20)) ''作成者
        Cells(cnt, 10) = Folder.GetDetailsOf(Folder.ParseName(Target), 4)   ''作成日時
        Cells(cnt, 11) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 14, 24)) ''コメント
        ActiveSheet.Hyperlinks.Add anchor:=Cells(cnt, 2), Address:="C:\sample\" & Cells(cnt, 2).Value
    Next
Return

End Sub

（β） 2015/04/15(水) 08:23

βさん
ありがとうございます！！
こんなに早く回答頂けて、改めて感謝、感心しております。

サブフォルダ内のファイルも出力することができました！
ただ、ハイパーリンクにエラーが発生するようになってしまいました。

エラーは「指定されたファイルを開くことができません。」というものです。

以前までのコードですと、指定したフォルダ内のファイルに対してハイパーリンクを適用
するようになっていると思いますが、今回頂いたコードでは、指定フォルダ内のファイル
においてもエラーが発生してしまいます。

このエラーに対してアドバイスを頂けますと幸いです。
よろしくお願い致します。
（スーパービギナー） 2015/04/15(水) 17:38

 失礼しました。

 ActiveSheet.Hyperlinks.Add anchor:=Cells(cnt, 2), Address:="C:\sample\" & Cells(cnt, 2).Value

 ここを元コードのままにしていました。

 ActiveSheet.Hyperlinks.Add anchor:=Cells(cnt, 2), Address:=Replace(f.Path, f.Name, "") & Cells(cnt, 2).Value

 このようにして試してみてください。

（β） 2015/04/15(水) 18:12

βさん
ありがとうございます!
Replaceですべてのフォルダが対象になるのですね！

ちなみにですが、
現在のコードですと、1行目から順に入力されていくと思います。
これを2行目以降にしようと思い、For Each f In fold.Filesの前にcntの初期値を決める文(例えばcnt=3)を入れたところ、3行目から入力されるのですが、あるところで再び3行目に戻って上書きしてしまいます。

指定フォルダのみの場合はうまくいっていたのですが、何がいけないのでしょうか。
教えてください。
よろしくお願いいたします。
（スーパービギナー） 2015/04/15(水) 19:25

エクセル以外のファイルも読んでしまっているようなので、エクセルファイル(xlsやxlsxなど）だけを対象とするための構文も併せて教えて頂けますと幸いです。

よろしくお願いいたします。
（スーパービギナー） 2015/04/15(水) 19:38

 20:50 cnt = 2 を忘れていたので追加。

 For Each f In fold.Files が書かれている　printinfo: ～ Return　のブロックは、CommandButton2_Click　の中にありますが
 いってみれば、サブプロシジャになっています。
 通常なら、CommandButton2_Click　とは別に、独立したサブプロシジャとして配置するところですが、CommandButton2_Click　で使っている多くの変数を受け渡すのが面倒なので
 同じプロシジャ内に配置しました。

 このブロックへは　 GoSub printinfo　でとんできます。つまり、フォルダ毎にとんできます。
 ですから、最初のフォルダで、cnt が増えていっても、次のフォルダで、またリセットされるわけですね。
 ３行目からセットするのであれば　CommandButton2_Click のはじめのほうで cnt = 2 としておきましょう。

 >Replaceですべてのフォルダが対象になるのですね！

 そうではありません。ここはフォルダパス\ファイル名としなければいけないので、
 そのフォルダパス\ を求めるためにこう記述してあります。
 でも、今、見直すと、おばかなコードです。
 ここは、ActiveSheet.Hyperlinks.Add anchor:=Cells(cnt, 2), Address:=f.Path
 これでよかったです。

 >エクセル以外のファイルも読んでしまっているようなので

 エクセルブック以外もあるのなら、ファイルを取得した後拡張子を判定します。

 以下、フルセット　再掲します。

 Private Sub CommandButton2_Click()
    Const Path As String = "C:\sample\"

    Dim fso As Object
    Dim pFold As Object
    Dim sFold As Object
    Dim fold As Object
    Dim f As Object

    Dim Shell As Object, Folder As Object, Target As String, cnt As Long
    Dim flag As Boolean
    Dim tmp As Variant

    cnt = 2

    tmp = Split(Application.OperatingSystem)
    If tmp(UBound(tmp)) = "5.01" Then flag = True 'XP
    Set Shell = CreateObject("Shell.Application")
    Set Folder = Shell.Namespace(Path)

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set pFold = fso.getfolder(Path)
    Set fold = pFold

    GoSub printinfo

    For Each fold In pFold.SubFolders
        Set Folder = Shell.Namespace(fold.Path)
        GoSub printinfo
    Next

    Set Folder = Nothing
    Set Shell = Nothing

    Exit Sub

printinfo:

    For Each f In fold.Files
        If LCase(fso.getextensionname(f.Name)) Like "xls*" Then
            Target = f.Name
            cnt = cnt + 1
            Cells(cnt, 2) = Folder.GetDetailsOf(Folder.ParseName(Target), 0)    ''ファイル名
            Cells(cnt, 3) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 12, 23)) ''分類
            Cells(cnt, 4) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 33, 18)) ''キーワード
            Cells(cnt, 5) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 10, 21)) ''タイトル
            Cells(cnt, 6) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 11, 22)) ''サブタイトル
            Cells(cnt, 7) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 35, 33)) ''会社
            Cells(cnt, 8) = Folder.GetDetailsOf(Folder.ParseName(Target), 3)   ''更新日時
            Cells(cnt, 9) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 9, 20)) ''作成者
            Cells(cnt, 10) = Folder.GetDetailsOf(Folder.ParseName(Target), 4)   ''作成日時
            Cells(cnt, 11) = Folder.GetDetailsOf(Folder.ParseName(Target), IIf(flag, 14, 24)) ''コメント
            ActiveSheet.Hyperlinks.Add anchor:=Cells(cnt, 2), Address:=f.Path
        End If
    Next
Return

End Sub

（β） 2015/04/15(水) 20:24

ありがとうございます！
完璧です！

最初から最後まで助けて頂き、感謝しきれないほどです！

追加での質問で申し訳ありませんが、
このコードとは別に、エクセルシート上でプロパティの設定をやろうとしています。
そこで下記のコードでプロパティの設定をしているのですが、コメントアウトしている項目がうまく設定できずエラーとなってしまいます。

もしこのエラーの原因がわかりましたら教えて頂けないでしょうか。
よろしくお願いいたします。

Private Sub CommandButton1_Click()

    '1 : タイトル
    ActiveWorkbook.BuiltinDocumentProperties.Item("Title") = Range("E1")

    '2 : サブタイトル
    ActiveWorkbook.BuiltinDocumentProperties.Item("Subject") = Range("E2")

    '3 : 作成者
    ActiveWorkbook.BuiltinDocumentProperties.Item("Author") = Range("E3")

    '4 : キーワード
    ActiveWorkbook.BuiltinDocumentProperties.Item("Keywords") = Range("E4")

    '5 : コメント
    ActiveWorkbook.BuiltinDocumentProperties.Item("Comments") = Range("E5")

    '6 : テンプレート
    ActiveWorkbook.BuiltinDocumentProperties.Item("Template") = Range("E6")

    '7 : 更新者
    ActiveWorkbook.BuiltinDocumentProperties.Item("Last Author") = Range("E7")

    '8 : 改訂番号
    'ActiveWorkbook.BuiltinDocumentProperties.Item("Revision number") = Range("E8")

    '9 : アプリケーション名
    ActiveWorkbook.BuiltinDocumentProperties.Item("Application Name") = Range("E8")

    '10 : 印刷日時
    'ActiveWorkbook.BuiltinDocumentProperties.Item("Last Print Date") = Range("E10")
    'Range("E10") = ActiveWorkbook.BuiltinDocumentProperties.Item(10)

    '11 : 作成日時
    'ActiveWorkbook.BuiltinDocumentProperties.Item("Creation Date") = Range("E11")

    '12 : 更新日時
    'ActiveWorkbook.BuiltinDocumentProperties.Item("Last Save Time") = Range("E12")

    '13 : 編集時間
    'ActiveWorkbook.BuiltinDocumentProperties.Item("Total Editing Time") = Range("E13")

    '14 : ページ数
    'ActiveWorkbook.BuiltinDocumentProperties.Item("Number of Pages") = Range("E14")

    '15 : 単語数
    'ActiveWorkbook.BuiltinDocumentProperties.Item("Number of Words") = Range("E15")
    'Range("E15") = ActiveWorkbook.BuiltinDocumentProperties.Item(15)

    '16 : 文字数
    'Range("E16") = ActiveWorkbook.BuiltinDocumentProperties.Item("Number of Characters")
    'Range("E16") = ActiveWorkbook.BuiltinDocumentProperties.Item(16)

    '17 : セキュリティ
    'Range("E17") = ActiveWorkbook.BuiltinDocumentProperties.Item("Security")

    '18 : 分類
     ActiveWorkbook.BuiltinDocumentProperties.Item("Category") = Range("E9")

    '19 : 形式
     ActiveWorkbook.BuiltinDocumentProperties.Item("Format") = Range("E10")

    '20 : 管理者
     ActiveWorkbook.BuiltinDocumentProperties.Item("Manager") = Range("E11")

    '21 : 会社名
     ActiveWorkbook.BuiltinDocumentProperties.Item("Manager") = Range("E12")

    '22 : バイト数
    'Range("E22") = ActiveWorkbook.BuiltinDocumentProperties.Item("Number of Bytes")
    'Range("E22") = ActiveWorkbook.BuiltinDocumentProperties.Item(22)

    '23 : 行数
    'Range("E23") = ActiveWorkbook.BuiltinDocumentProperties.Item("Number of Lines")
    'Range("E23") = ActiveWorkbook.BuiltinDocumentProperties.Item(23)

    '24 : 段落数
    'Range("E24") = ActiveWorkbook.BuiltinDocumentProperties.Item("Number of Paragraphs")
    'Range("E24") = ActiveWorkbook.BuiltinDocumentProperties.Item(24)

    '25: スライドの数
    'Range("E25") = ActiveWorkbook.BuiltinDocumentProperties.Item("Number of Slides")
    'Range("E25") = ActiveWorkbook.BuiltinDocumentProperties.Item(25)

    '26 : メモの数
    'Range("E26") = ActiveWorkbook.BuiltinDocumentProperties.Item("Number of Notes")
    'Range("E26") = ActiveWorkbook.BuiltinDocumentProperties.Item(26)

    '27 : 非表示スライドの数
    'Range("E27") = ActiveWorkbook.BuiltinDocumentProperties.Item("Number of Hidden Slides")
    'Range("E27") = ActiveWorkbook.BuiltinDocumentProperties.Item(27)

    '28 : マルチメディアクリップの数
    'Range("E28") = ActiveWorkbook.BuiltinDocumentProperties.Item("Number of Multimedia Clips")
    'Range("E28") = ActiveWorkbook.BuiltinDocumentProperties.Item(28)

    '29 : ハイパーリンクの基点
     ActiveWorkbook.BuiltinDocumentProperties.Item("Hyperlink Base") = Range("E13")

    '30 : 文字数（スペースを含む）
    'Range("E30") = ActiveWorkbook.BuiltinDocumentProperties.Item("Number of Characters (with space)")
    'Range("E30") = ActiveWorkbook.BuiltinDocumentProperties.Item(30)

End Sub
（スーパービギナー） 2015/04/15(水) 21:12

  一般論としていえば、あるオブジェクトがあって、そのプロパティがあるとして、

 １．最初から初期値として準備されているもの
 ２．何かの処理によって、はじめて、そのプロパティが実体化するもの（それまではNothing等）
 ３．ほかの共通のアプリ等で共用するために、プロパティ名は準備されているけど、当該アプリでは、永久に実体化しないもの。

 こんなようなものがありますね。特に、BuiltinDocumentPropertiesはMs.Office共有のテンプレートでしょうから
 Wordだけが有効なもの、PowerPointだけが有効なものもあるんでしょうね。（３．のケースです）

 現在、xl2013では、ID は 1～34 なんですが、当方でメンテ用に使っているユーティリティコードを走らせますと
 以下が【参照不能】になります。そちらの結果とは差異がありますが、いずれにしても、３．ないしは２．だと
 そう割り切って、今まであまり気にも留めませんでした。

 当方で参照不能になる項目

 Total editing time	13
 Number of pages	14
 Number of words	15
 Number of characters	16
 Number of bytes	22
 Number of lines	23
 Number of paragraphs	24
 Number of slides	25
 Number of notes	26
 Number of hidden Slides	27
 Number of multimedia clips	28
 Number of characters (with spaces)	30

 たとえば、以下のようなコードを実行して Stop で止まった時点で、ローカルウィンドウを表示して
 +dp となっているところをクリックすると、Item1～　がでてきます。
 それぞれの Item〇　をクリックすると、その内容がでてきますので、その中の Value を見てください。
 そこが <アプリケーション定義またはオブジェクト定義のエラーです> となっているものは、前述の ３．だろうと思っています。

 Sub test()
    Dim dp As Object
    Set dp = ActiveWorkbook.BuiltinDocumentProperties
    Stop
 End Sub

（β） 2015/04/16(木) 06:53

Excelが自動的に値を更新するものは、マクロからの操作を禁じているのだと思われます。
新しいブックで、以下のマクロを試してみてください。

 Sub test()
    Dim i As Long

    With ActiveWorkbook.BuiltinDocumentProperties
        For i = 1 To .Count
            Cells(i, "A").Value = i
            Cells(i, "B").Value = .Item(i).Name
            Cells(i, "C").Value = .Item(i).Type
            If .Item(i).Type <> msoPropertyTypeDate And .Item(i).Type <> msoPropertyTypeNumber Then
                Cells(i, "D").Value = .Item(i).Value
            Else
                Cells(i, "D").Value = "#"
            End If
        Next i
    End With
 End Sub
（???） 2015/04/16(木) 09:56

 (???)さんのコメントを受け、新規ブックに以下のマクロを書いて保存後、実行してみました。

 Sub Check()
    Dim i As Long
    With ActiveWorkbook.BuiltinDocumentProperties
        For i = 1 To .Count
            On Error Resume Next
            Cells(i, "A").Value = i
            Cells(i, "B").Value = .Item(i).Name
            Cells(i, "C").Value = .Item(i).Type
            Cells(i, "D").Value = "###"
            Cells(i, "D").Value = .Item(i).Value
            On Error GoTo 0

            On Error GoTo Skip
            Cells(i, "E").Value = "変更NG"
            .Item(i) = 1
            Cells(i, "E").Value = "変更OK"
Skip:
            On Error GoTo 0
        Next
    End With
 End Sub

 結果について、疑問に思うところもあるのですが、以下でした。

 １回目の実行

 値の参照ができず、### と表示されたものが　10,13～16,22～28,30
 変更はすべてがＯＫ表示。
 （参照は不可で、書き込みがＯＫというのも？？ですが。
 　書き込みがなされるまでは、これらプロパティは私が申し上げた、２．にあたるもので、
 　書き込んだことで、プロパティが実体化しているんだと推測します）

 ２回目の実行

 すべて値参照ができます。（エラーにはならない）
 で、その値は、全項目 1 (１回目でセットした値）になっています。

（β） 2015/04/16(木) 11:33

βさんのコーディングで、気になって点があったので、余談なぞ。

On Error GoTo文は、GoTo文ではないので、注意。
エラー時の処理先に飛んだ後、Resume文で戻ってこないといけません。
以下の2つをステップ実行すると理解できるかと思います。

 Sub test1()
    Dim i As Long
    Dim j As Long

    For i = 1 To 10
        On Error GoTo sError
        j = 2 ^ 32
        Debug.Print i, j
 sError:
        On Error GoTo 0
    Next i
 End Sub

 Sub test2()
    Dim i As Long
    Dim j As Long

    On Error GoTo sError

    For i = 1 To 10
        j = 2 ^ 32
        Debug.Print i, j
 sNext:
    Next i

    On Error GoTo 0
    Exit Sub

 sError:
    Resume sNext
 End Sub
（???） 2015/04/17(金) 12:14

 TO (???)さん

 ご指摘並びにご教示、深謝です。
 普段、基本的に（通常の GoTo も含め）Goto　を使わない主義で、そのあたりがわかっていませんでした。

 勉強のために教えていただけますか。
 Test2 を以下のように記述変更してみました。結果は意図通りなんですが、書き方として、不都合な点あれば
 ご指摘願います。

 Sub test3()
    Dim i As Long
    Dim j As Long

    For i = 1 To 10
        On Error GoTo sError
        j = 2 ^ 32
        Debug.Print i, j
sError:
       Resume sNext
sNext:
    Next i
 End Sub

（β） 2015/04/17(金) 13:23

計算がエラーにならなかった場合、エラールーチンに飛んでいないのに、Resumeを実行してしまうところが気持ち悪いですね。
実際に、jの計算をエラーにならないようにしてステップ実行すると、少し引っかかる感じになります。

ここを解決すると、以下の書き方になりますが、GoTo文のせいでちょっと汚い感じですねぇ。
やっぱり、エラー処理は外側に書く方が良いと思います。

 Sub test3b()
    Dim i As Long
    Dim j As Long

    For i = 1 To 10
        On Error GoTo sError
        j = 2 ^ 32
        Debug.Print i, j
        GoTo sNext
 sError:
       Resume sNext
 sNext:
    Next i
 End Sub
（???） 2015/04/17(金) 14:04

ちなみに、お薦めはOn Error Resume Nextだけ利用。余計なラベルを書かなくて済みますから。
あとは適切なところでErr.Clearする事と、エラー判定する範囲を最小限にすることですね。

 Sub test4()
    Dim i As Long
    Dim j As Long

    On Error Resume Next

    For i = 1 To 10
        Err.Clear
        j = 2 ^ 32
        If Err.Number = 0 Then
            Debug.Print i, j
        End If
    Next i

    On Error GoTo 0
 End Sub
（???） 2015/04/17(金) 14:17

 >お薦めはOn Error Resume Nextだけ利用

 なるほど。ありがとうございました。

 （確かにエラーがないときに、ステップ実行で、「ちょっとひっかかる」感じがしました。）

（β） 2015/04/17(金) 14:26

βさん、???さん
ご回答ありがとうございました。
やはり自動更新される項目への入力はできないんですね。
よく考えればわかることでした...。

話は戻りまして、βさんに頂いたファイル一覧出力のコードの件で教えて頂きたいです。

最後に頂いたコードは指定フォルダとその一つ下のサブフォルダ内のファイルを対象とするものでしたが、そのもう一つまで、さらにもう一つ下までといったように対象とする階層を自由に変えたい時は、どこをどう変えたらよいのでしょうか。

アドバイスのほど、よろしくお願いいたします。
（スーパービギナー） 2015/04/18(土) 00:10

 まず、「やはり自動更新される項目への入力はできないんですね。」

 いえいえ、（β） 2015/04/16(木) 11:33　で提示した通り、できますよ。
 項目にセットしたら、そのオブジェクトが実体化して、プロパティとして参照可能になります。
 ただ、Number of slides　なんかはPowePoint用のプロパティだと思いますし、そこに何かをいれてもあまり意味がないですよね。

 新規ブックに以下を書いて保存した後、実行してみてください。
 （β） 2015/04/16(木) 11:33　では、エラートラップを掛けていましたが、大丈夫だということがわかったので
 以下では、エラー対応はしていません。

 Sub 更新OKですよ()
    Dim i As Long
    With ThisWorkbook.BuiltinDocumentProperties
        '全項目に 10 を入れる
        For i = 1 To .Count
            .Item(i) = 10
        Next
        '項目を入れた後参照してみる
        For i = 1 To .Count
            Cells(i, "A").Value = .Item(i).Name
            Cells(i, "B").Value = .Item(i).Value
        Next
    End With
 End Sub

 で、フォルダ階層ですが、そういう要件なら、再帰コードにして、
 そのなかでフォルダ階層を聞いて実行継続、実行終了という制御にすればいいと思いますが
 無条件に、最後の階層までというのでは、なぜダメなんでしょうか？

（β） 2015/04/18(土) 06:22

βさん

 2015/04/16(木) 11:33の内容を見逃しておりました。
自動更新のものも入力できました！

フォルダ階層の件ですが、
各サブフォルダの途中の階層にゴミ箱フォルダを作りたく、そのフォルダは対象外としたいためです。

正直なところ、途中の階層までの方法と最後の階層までの方法両方を知りたいのですが、途中の階層までの方法がわかればその延長で最後の階層まで対応できると思ったので、そのような質問をしました。

（スーパービギナー） 2015/04/18(土) 09:25

 最後の階層までということなら定番の処理コードが広く流布していますので、それで実行すれば簡単ですが
 階層レベルを特定するということになると（β的には）少し細工をしなきゃいけないので。

 ゴミ箱フォルダの名前を固定にできれば、そのフォルダはスキップということで、定番コードを利用できますが？

（β） 2015/04/18(土) 09:41

そうですよね...ゴミ箱フォルダスキップの方法でやってみたいと思います！

お時間が許されるならその方法を教えて頂けないでしょうか。
よろしくお願いいたします。
（スーパービギナー） 2015/04/18(土) 10:17

 シートモジュールに。なお、以下のコードでは、ごみ箱フォルダの名前を　"ごみ" にしています。
 実際のものに変更して使ってください。

 Option Explicit

 Dim fso As Object
 Dim cnt As Long
 Dim Shell As Object
 Dim flag As Boolean

 Private Sub CommandButton2_Click()
    Dim Path As String
    Dim tmp As Variant

    Application.ScreenUpdating = False

    flag = False
    tmp = Split(Application.OperatingSystem)
    If tmp(UBound(tmp)) = "5.01" Then flag = True 'XP
    Set Shell = CreateObject("Shell.Application")
    Set fso = CreateObject("Scripting.FileSystemObject")
    cnt = 2
    Path = "C:\sample"

    GetBookInfo Path

 End Sub

 Private Sub GetBookInfo(strPath As String)
    Dim folder As Object
    Dim subfolder As Object
    Dim file As Object
    Dim nmSpace As Object
    Dim Target As Object

    Set folder = fso.GetFolder(strPath)

    For Each subfolder In folder.SubFolders
        If subfolder.Name <> "ごみ" Then
            '再帰的呼び出し
            GetBookInfo subfolder.Path
        End If
    Next

   'カレントフォルダ内のファイルを列挙
    Set nmSpace = Shell.Namespace(strPath & "\")
    For Each file In folder.Files
        With file
            If LCase(fso.getextensionname(file.Name)) Like "xls*" Then
                Set Target = nmSpace.Parsename(file.Name)
                cnt = cnt + 1
                Cells(cnt, 2) = nmSpace.GetDetailsOf(Target, 0)    ''ファイル名
                Cells(cnt, 3) = nmSpace.GetDetailsOf(Target, IIf(flag, 12, 23)) ''分類
                Cells(cnt, 4) = nmSpace.GetDetailsOf(Target, IIf(flag, 33, 18)) ''キーワード
                Cells(cnt, 5) = nmSpace.GetDetailsOf(Target, IIf(flag, 10, 21)) ''タイトル
                Cells(cnt, 6) = nmSpace.GetDetailsOf(Target, IIf(flag, 11, 22)) ''サブタイトル
                Cells(cnt, 7) = nmSpace.GetDetailsOf(Target, IIf(flag, 35, 33)) ''会社
                Cells(cnt, 8) = nmSpace.GetDetailsOf(Target, 3)   ''更新日時
                Cells(cnt, 9) = nmSpace.GetDetailsOf(Target, IIf(flag, 9, 20)) ''作成者
                Cells(cnt, 10) = nmSpace.GetDetailsOf(Target, 4)   ''作成日時
                Cells(cnt, 11) = nmSpace.GetDetailsOf(Target, IIf(flag, 14, 24)) ''コメント
                ActiveSheet.Hyperlinks.Add anchor:=Cells(cnt, 2), Address:=file.Path
            End If
       End With
    Next
 End Sub

（β） 2015/04/18(土) 10:33

βさん

できました！
素晴らしすぎて言葉もありません！
ありがとうございます！！

1点教えて頂きたいのですが

シートモジュールにと指示されたのはどういった理由からでしょうか。
（スーパービギナー） 2015/04/18(土) 12:01

 >シートモジュールに と指示されたのはどういった理由からでしょうか。

 特に意味はありません。
 もともとのコードが　Private Sub CommandButton2_Click() でしたので、
 あぁ、シートモジュールに書かれたクリックイベントコードなんだなと理解していましたので。

 通常の標準モジュールの普通の名前のプロシジャにしても、もちろん、いいですよ。

（β） 2015/04/18(土) 12:49

コメント返信：

[ 一覧(最新更新順) ]

[[20150321182359]] 『フォルダ内のエクセルブックのプロパティ取得』（スーパービギナー） ページの最後に飛ぶ

[[20150321182359]]　『フォルダ内のエクセルブックのプロパティ取得』（スーパービギナー）　ページの最後に飛ぶ