エクセルVBA（セル情報集約プログラム）

指定した参照フォルダの中のファイルを再帰的に取得し特定のセルの情報を集め出力先ブックへ転記されるプログラムを作っております。
プログラム自体は動くのですが、改善点を指摘され、いろいろ書きなおしてみたものの動かず途方に暮れています。
どのように書き直したらよいかご教授ください。

改善点
モジュール１のなかでファイル内のセルをコピペした後、同モジュール内でフォルダ再起のプログラムが書かれており、callで自分自身を呼び出しているが、オブジェクト指向の観点からよくないので分けること。（サブルーチン内で自分自身を呼び出すプログラムはよろしくないとのこと）

実際のプログラム
Option Explicit

Sub CommandButton1_Click() 'テキストボックスに指定したフォルダのフルパスをいれる
Dim folder As Object
Dim file As Object


Set folder = CreateObject("Shell.Application"). _
BrowseForFolder(0, "フォルダを選択してください", 0, "C:\")

'キャンセル選択でのエラー回避
If Not folder Is Nothing Then
参照.Value = folder.self.Path

End If

End Sub

Sub CommandButton2_Click() 'テキストボックスに指定したファイルのフルパスをいれる

Dim fpath As String 'ファイル名フルパスを格納

'キャンセルによるエラー回避
On Error Resume Next

'出力先ファイル選択（EXCELファイルのみを指定）
fpath = Application.GetOpenFilename(filefilter:="Excelファイル,*.xlsx;*.xls")

'ファイルが選択されなかった場合、出力テキストボックスに空欄を返す処理
If fpath = "" Then
出力.Text = ""
Else
出力.Text = fpath
End If

End Sub

Sub CommandButton3_Click()　'参照先フォルダ内もファイルを取得し転記するプログラム
Dim check1 As String '参照フォルダフルパスを格納
Dim check2 As String '出力先ファイルフルパスを格納
Dim c1 As String '参照フォルダ名を格納
Dim c2 As String '出力先ファイルを格納
Dim starttime As Single '計測開始時間を格納
Dim myspeed As Single '処理時間を格納


'処理時間計測開始
starttime = Timer

check1 = 参照.Value
check2 = 出力.Text

'テキストボックス無記入の際に出す注意表示
Do While (check1) = "" Or (check2) = ""
MsgBox "フォルダ、ファイル名を入力してください"
Exit Sub
Loop

'フォルダ名、ファイル名を取得
c1 = Dir(check1, vbDirectory)
c2 = Dir(check2)


If c1 = "" Then
MsgBox "指定されたフォルダまたはファイルは存在しません"
ElseIf c2 = "" Then
MsgBox "指定されたフォルダまたはファイルは存在しません"
End If

'処理と関係のないフォルダを指定された場合のエラー処理
'特定の文字列が含まれているか否かで判断(" "中の文字列を変えることで対象フォルダの変更可能)
If InStr(check1, "半期計画シート") = 0 Then
MsgBox "そのフォルダは指定できません"
Exit Sub
Else
End If
'以上ここまでが各種エラー処理--------------------------------------------------------------------


'ここでモジュール１へ飛ぶ
Call Sample3(参照.Value)

'処理時間計測終了、処理時間表示
myspeed = Timer - starttime
MsgBox "処理時間は" & myspeed & "秒です"

モジュール１

Dim i As Integer


Sub Sample3(folder As String)
Dim strfilename As String, f As Object
Dim fpath2 As String 'ユーザーフォーム出力先テキスト(ファイル名フルパス)を格納
Dim bookname2 As String 'ブック名を格納


fpath2 = UserForm1.出力.Text

bookname2 = Dir(fpath2)
strfilename = Dir(folder & "\*.xlsx")

'フォルダ再起の際変数iの数値が０になることを防止
If i = 0 Then
i = Cells(Rows.Count, 1).End(xlUp).Row + 1
End If

'処理高速化のため画面のちらつきを防止
Application.ScreenUpdating = False


Workbooks.Open fpath2


Do While strfilename <> ""

'注意表示の無効化

Application.DisplayAlerts = False
'画面の更新設定を元に戻す
Cells(i, 1).Value = ExecuteExcel4Macro("'" & folder & "\" & "[" & strfilename & "]Sheet1'!R2C10")
'ほかにもコピペするセルがあるが、同じ文法かつ文字数の都合上カット
Application.ScreenUpdating = True


'次のファイル名取得
strfilename = Dir()
i = i + 1
ActiveWorkbook.Save
Loop
'----------------------------------------------------------------------------------------------------------------------
'フォルダを再帰（フォルダ配下のフォルダを探す）
With CreateObject("Scripting.FileSystemObject")

For Each f In .GetFolder(folder).SubFolders

Call Sample3(f.Path)

Next f

End With
'注意表示設定を元に戻す
Application.DisplayAlerts = True

End Sub

No.2 回答者： WindFaller 回答日時： 2019/07/12 21:26

>オブジェクト指向の観点からよくないので分けること。

（サブルーチン内で自分自身を呼び出すプログラムはよろしくないとのこと）

VBAにオブジェクト指向なんてありません。再帰は正当なブログラムの書き方です。良くも悪くもありません。

このコードで、時間計測のプログラムをつけていることから、質問者さんにには、プログラムは遅いのではないかというご懸念があるのだろうと想像はします。

再帰を使っているということは、サブフォルダーの下にまたフォルダーがあったりして、フォルダー構造が不明な場合に使います。フォルダーを掘り下げていくような造りをしていない場合、言い換えると、一定のサブフォルダーが決まっている場合、Dir 関数で、ファイルを出す一般のプログラムにするだけで済みます。
ただ、今回のプログラムは、VBScriptのコードを借用したもので、VBAオリジナルのコードとは言えないだけです。

No.1 回答者： lv4u 回答日時： 2019/07/11 07:32

＞＞オブジェクト指向の観点からよくないので分けること。

（サブルーチン内で自分自身を呼び出すプログラムはよろしくないとのこと）

オブジェクト指向の観点でみて、サブルーチン内で自分自身を呼び出しても問題ありません。