excelのファイルとセル値を書き出したい

質問

excel2003を利用しています。
とあるフォルダにある excelファイル名(自分自身のファイルを除く）
を全て書き出して、
且つ A１セルの値をB列に書き出すことを、やろうとvbaを作ってみましたが。
最後のファイルのA1セルを書きだすところで、エラーになっていまい
そこだけ空白になってしまいます。※写真参照

記述は以下の通りです。どのように修正すればよいか
教えていただけないでしょうか？
また他にもっと優れた記述があれば、そちらも教えて欲しいです。
よろしくお願いします。

Sub test()
Dim buf As String, cnt As Long
Dim Path As String
Path = ThisWorkbook.Path & "\"
buf = Dir(Path & "*.xls")
cnt = 2
Do While buf <> ""
If buf <> ThisWorkbook.Name Then
cnt = cnt + 1
Cells(cnt, 1) = buf
buf = Dir()
Workbooks.Open Filename:=Path & "\" & buf
MsgBox Workbooks(buf).Worksheets(1).Range("A1").Value
Cells(cnt, 2) = Workbooks(buf).Worksheets(1).Range("A1").Value
Workbooks(buf).Close
End If
Loop
End Sub

回答No.2

kkkkkm

buf = Dir() の場所が早すぎるのでフィル名とA1セルの内容が一個ずれていませんか?

最終までファイル名を探し終わってbufが""なのに
Workbooks.Open Filename:=Path & "\" & buf
とファイル名の無い構文でファイルを開こうとしてエラーになっています。

以下のように訂正してください。

Do While buf <> ""
If buf <> ThisWorkbook.Name Then
cnt = cnt + 1
Cells(cnt, 1) = buf
Workbooks.Open Filename:=Path & "\" & buf
MsgBox Workbooks(buf).Worksheets(1).Range("A1").Value
Cells(cnt, 2) = Workbooks(buf).Worksheets(1).Range("A1").Value
Workbooks(buf).Close
End If
buf = Dir()
Loop

お礼

回答ありがとうございます。
まさに　buf = Dir()　の記述の意味を理解しておりませんでした。
勉強になりました。

回答No.1

keithin

そもそもあなたの今のマクロの結果で，各ブックに実際に記入されてるＡ１の値が正しく記録できてなくて，一つずつずれてることを確認して下さい。

sub macro1()
　dim myPath as string　’予約語Pathを変数名に使わない
　dim myFile as string
　dim cnt as long

　cnt = 2
　mypath = thisworkbook.path & "\"
　myfile = dir(mypath & "*.xls*")

　do until myfile = ""
　　if myfile <> thisworkbook.name then
　　　cnt = cnt + 1
　　　cells(cnt, "A") = myfile
　　　workbooks.open filename:=mypath & myfile　’￥は既に付けてある
　　　cells(cnt, "B").value = workbooks(myfile).worksheets(1).range("A1").value
　　　workbooks(myfile).close false
　　end if
　　myfile = dir()　’次は一連の仕事を終えたあとに取得
　loop
end sub

お礼

回答ありがとうございます。
なんとか自分で対処したかったのですが、
あともう少し、もう一歩まで、行き届きませんでした。
いつも、多くを勉強させていただき本当にありがとうございます。