VBAで複数ファイルのページ数出力

質問

Win10のOffice365のExcelを使用しています。

GetOpenFilenameで選択した複数のExcelファイルのファイル名＋印刷ページ数を
マクロを実行したファイルに出力するというマクロを作成しました。

マクロを実行する度に既存データがあれば追加されていくようにしたいのですが、上手くいきません。
それどころか、実行時も複数ファイル選択したにも関わらず、
１ファイルのデータしか出力されない状態です。

実行後のイメージは添付ファイルの通りです。
（A1、A2はデフォルトで入力しています。）
勉強を始めたばかりなので改善点もあれば、教えて頂きたいです。

よろしくお願い致します。
=================================================
Option Explicit

Sub pagecount()

Dim Page As Long, cnt As Long, xlcnt As Long
Dim fs As Variant, path As Variant
Dim Fname As String
Dim i As Integer
Dim wb1 As Workbook, wb2 As Workbook
Dim sh As Worksheet

With CreateObject("WScript.Shell")
.CurrentDirectory = ThisWorkbook.path
End With

fs = Application.GetOpenFilename(filefilter:="Microsoft Excelブック,*.xls*", MultiSelect:=True)

If IsArray(fs) Then
For Each path In fs

Set wb1 = Workbooks.Open(path, , True)
Set wb2 = ThisWorkbook

Do Until (Fname = "")

Page = 0

For Each sh In wb1.Worksheets
Page = Page + sh.PageSetup.Pages.Count
Next sh

xlcnt = Cells(Rows.Count, 1).Row
cnt = Cells(xlcnt, 1).End(xlUp).Row

If wb2.ActiveSheet.Cells(cnt, 1).Value <> "" Then

wb2.ActiveSheet.Cells(cnt, 1).Value = Fname
wb2.ActiveSheet.Cells(cnt, 1).Offset(0, 1) = Page

wb1.Close savechanges:=False

Fname = Dir()
cnt = cnt + 1

End If
Loop

Next path
End If

End Sub

回答No.2

micnak · ベストアンサー

Sub PageCount()

'出力先の用意
Dim OutputSheet As Worksheet
Set OutputSheet = ThisWorkbook.Worksheets("Sheet1") '<=実際のシート名にする｡
Dim RowNumber As Long
Const RowStart = 2
RowNumber = RowStart

'最初の空行を探す
While OutputSheet.Cells(RowNumber, 1).Value <> ""
RowNumber = RowNumber + 1
Wend

With CreateObject("WScript.Shell")
.CurrentDirectory = ThisWorkbook.Path
End With

Dim FileList As Variant
FileList = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xls*", MultiSelect:=True)

Dim Path As Variant
For Each Path In FileList

Dim BookToPrint As Workbook
Set BookToPrint = Workbooks.Open(Path, , True)
OutputSheet.Cells(RowNumber, 1).Value = BookToPrint.Name

Dim PageCount As Long
PageCount = 0

Dim sh As Worksheet
For Each sh In BookToPrint.Worksheets
PageCount = PageCount + sh.PageSetup.Pages.Count
Next
OutputSheet.Cells(RowNumber, 2).Value = PageCount
BookToPrint.Close False
RowNumber = RowNumber + 1
Next

End Sub

# ほとんどの場合､タイピングする時間より､修正したり､理解するために読み解いたりする時間のほうが長いので､変数名は省略しすぎず､読んで意味がわかるようにつけたほうが良いと思います｡wb2 = ThisWorkbook とするぐらいなら､ThisWorkbookと毎回入力するほうがまだわかりやすいと思います｡上のコードは少しやりすぎかもしれませんが｡
# 局所的にしか使わない変数は直前に宣言するほうが読みやすいと思うので､そのようにしていますけれど､多くの入門書等の流儀とは違うと思うので､自分にあった方法を選択してください｡

お礼

すごいです！問題なく動作しました！
ありがとうございます！

読みやすいお作法も教えて頂きありがとうございます。
個人的にfor nextやdo loopが混ざりすぎて、複雑になってきているなと思っていたので、非常に勉強になりました。
ありがとうございました。

回答No.1

micnak

動作として希望するのは､ダイアログで選択したファイルを表示することですか｡特定のフォルダ内のファイルをすべて表示することですか｡
たぶん､拾ったコードを流用する際に2つの目的のコードが混ざってしまっています｡

直接エラーとなっている原因は､Do Loopの中で1回目にFnameを取得しているので､2回めにLoopに入ったときにはFnameが""でなくて､Loop内の処理を行う前にLoopを抜けてしまっていることです｡

補足

回答ありがとうございます。
希望動作はダイアログで選択したファイルを表示することです。

エラー原因勉強になります。
もし良かったら、どのように改善すればよいかご教授頂いてもよろしいでしょうか。