Excel VBA インデックスが有効範囲にない

質問

よろしくお願いします。
Excel VBA　初心のものです。

プログラムを作ってみたのですが、
「インデックスが有効範囲にありません」となってその先に進めません。

ソースですが
------------------------------------------------------

Private Sub CommandButton1_Click()

Dim buf As String, cnt As Long
Dim TMP As Variant

Const Path As String = "D:\Excel\sample\"

buf = Dir(Path & "*.xls*")

Set TMP = Workbooks(buf).Sheets("testdata").Range("A1").Value

Do While buf <> ""
cnt = cnt + 1
Cells(cnt, 1) = buf
Cells(cnt, 2) = FileDateTime(Path & buf)
Cells(cnt, 3) = TMP
buf = Dir()
Loop

End Sub

------------------------------------------------------

エラーになる箇所は

Set TMP = Workbooks(buf).Sheets("testdata").Range("A1").Value

のところです。

このプログラムで何をしたいかと言いますと

DドライブのExcel＞sample　というフォルダの中にある

・すべてのエクセルブック名（ファイル数は３個）と、
・そのブックの作成日時と、
・testdataというシート（各ブックに必ずあるシートです）のセルA1に入っている値

を実行ファイルのSheet1に書き出す、

というものです。

プログラムの実行ファイルはExcelフォルダ直下にあります。

どこが問題でエラーになっているのか分かりません。

ご指南よろしくお願いします。

回答No.3

keithin · ベストアンサー

通常はシンプルに
１．ブックを拾う
２．拾ったブックを実際に開く
３．該当のデータを転記する
４．ブックを閉じる
５．繰り返す
といった段取りにします。

「開かずにデータを抜き取る」サンプルマクロも検索すればすぐにヒットしますが、ざっとこんな具合です。
sub macro1()
　Dim buf As String, cnt As Long
　Dim TMP As Variant

　Const myPath As String = "D:\Excel\sample\"

　buf = Dir(myPath & "*.xls*")

　Do While buf <> ""
　　cnt = cnt + 1
　　Cells(cnt, 1) = buf
　　Cells(cnt, 2) = FileDateTime(myPath & buf)
　　Cells(cnt, 3) = executeexcel4macro("'" & mypath & "[" & buf & "]testdata'!R1C1")
　　buf = Dir()
　Loop
end sub

尤も、個人的には
cells(cnt,3).formula = "='" & mypath & "[" & buf & "]testdata'!A1"
の方が簡単で応用も広いと思いますが。

お礼

ブックを開かずにデータを取る方法まで教えていただき助かりました。
お蔭様でシンプルな手順を踏んだ方法でもプログラムを作ることが出来
活用させていただいてます。

回答いただきありがとうございました。

回答No.2

bin-chan

SET TMPの行でセル指定まで行ってるけど、
まだ開いてもいないBook・Sheetは利用できません。
段階を踏んで下さい。

お礼

段階を踏んで動かせるようになりました。

回答いただきありがとうございました。

回答No.1

samtomsan

> Dim buf As String
> buf = Dir(Path & "*.xls*")
bufはStringで何文字入りますか。
"*.xls*"でファイル数はいくつあり、何文字になりますか。
この場合に複数のファイルはどの様にbufに格納されるか判りますか。
この辺り(文字数)が範囲を越えているかどうか確かめてみてください。

お礼

文字数等範囲のこと知りませんでした。
勉強します。
回答いただきありがとうございました。