特定フォルダに複数ファイルが存在する場合に、指定したファイルパスを取得する方法

特定フォルダに複数ファイルが存在した場合の処理について、以下の方法を考えているのですがもっとよい処理方法があれば教えて頂きたいです。

処理としては以下になります。
前提:特定フォルダ（今回はC:\AAAAとします）にS1_YYYYMMDD__計算データ.csvというフォルダが格納される

特定フォルダ内にS1_YYYYMMDD__計算データ.csvというフォルダが存在するかチェックする

1つしかない場合はそのままファイルのフルパスを返して処理を終了する

複数あった場合は、画面に以下のMSGを表示する

【C:\AAAA配下にファイルが複数存在します。S1_YYYYMMDD__計算データ.csvを読込ますか？】
はいを押下時は、メッセージボックスに表示したファイルのフルパスを返して処理を終了
いいえを押下時は次のファイルを探して処理を実施する

いいえを押下し続け、フォルダ内を全部検索し終わった場合は

【読込対象ファイルが存在しません】を出力する
※なお、今回はC:\AAAAフォルダを表示してユーザー側に直接ファイルを選択させる、という方法は利用不可になっています。

条件を満たすように以下のコードを書いてみたのですが、処理的にあまりスマートではないのでは？と思っています。
改善策がありましたらご教示いただけないでしょうか。

html
1Sub FilePassGet() as Strung
2Dim rootFolder As String, rootname As String, FileName As String, Filename2 As String    
3rootFolder = "C:\AAAA"
4
5rootname = "S1_"
6If rootFolder = "" Then 
7　　　MsgBox "フォルダが存在しません"
8　　　END
9End if
10
11
12 rootname = "*" & rootname & "_計算データ*.csv"    
13If Dir(rootFolder, vbDirectory) = "" Then 　　　
14MsgBox "計算データファイルが存在しません"
15　　　END
16End if
17
18FileName = Dir(rootFolder & "\" & rootname, vbNormal)
19
20  If FileName = "" Then Err.Raise 53   
21
22If FileName = ""  Then 　　　
23MsgBox "計算データファイルが存在しません"
24　　　END
25End if
26 
27
28Filename2 = Dir()    
29Dim infomsg As String, msg As String
30
31If Filename2 <> "" Then
32      infomsg = "{0}配下にファイルが複数存在します。{1}を読込ますか？"
33      infomsg = Replace(Replace(infomsg, "{0}", rootFolder), "{1}", FileName)        
34      msg = MsgBox(infomsg, vbYesNo + vbQuestion)       
35   If msg <> 6 Then
36     FileName = Filename2        
37    infomsg =  "{0}配下にファイルが複数存在します。{1}を読込ますか？"
38    infomsg = Replace(Replace(infomsg, "{0}", rootFolder), "{1}", FileName)
39
40       msg = MsgBox(infomsg, vbYesNo + vbQuestion)        
41       FileName = Dir()
42
43       Do While FileName <> ""
44
45           msg = MsgBox(infomsg, vbYesNo + vbQuestion)
46
47           FileName = Dir()
48
49           If msg <> 6 Then GoTo msgEnd
50
51       Loop        
52
53      If  FileName = "" Then 　　　
54       MsgBox "読込対象ファイルが存在しません"
55　　　  END
56      End if
57
58        
59    End If    
60End If
61
62msgEnd: 
63
64
65FilePassGet = FileName
66
67End Sub