VBAで行うフォルダ・ファイル検索順について

VBAでフォルダを指定してエクセルファイル名を検索し、ファイル名のリストを作成しようとしています（Excel2010)。フォルダおよびファイルを連番で名づけた順に取得したいのですが、検索するフォルダが、01**,02**,03**・・・110**という連番で名づけられていた場合、検索順が、01,02,03,・・・09,110,111,112、・・となり、連番順に検索できません。1,2,3,・・・10,11・・と名付けると、1**からではなく10**から検索されてしまいます。
01,02,03**・・順で取得する方法と、1,2,3**・・の連番順で取得する方法を教えていただけるでしょうか。
よろしくお願いします。

Sub FileSearch(strPath As String)
Dim fso As Object
Dim strFolder As Variant
Dim strFile As Variant
Dim strPathExcel() As String
Dim l As Long
Set fso = CreateObject("Scripting.fileSystemObject")
For Each strFolder In fso.getfolder(strPath).subfolders
Call FileSearch(strFolder.Path)
Next strFolder
l = 0
For Each strFile In fso.getfolder(strPath).Files
If InStr(strFile.Type, "Excel") > 0 Then
ReDim Preserve strPathExcel(l)
strPathExcel(l) = strFile.Path
l = l + 1
End If
Next strFile
End Sub

No.1 ベストアンサー 回答者： WindFaller 回答日時： 2015/04/10 19:14

こんにちは。

エクセル VBAだと思いますが、シートに出して、そこで関数やソートなどと組合せて操作したほうが早いと思います。

もし、コードで行うなら、フォルダの中身自体をソートするのかは分かりませんが、まず、以下のようにフォルダとファイルを分離することでしょうね。そして、フォルダに、ソートアルゴリズムを通せばよいです。ただ、ややこしいし、今のところ、一つ下のフォルダーしか調べていません。


'//
Sub TestMacro1()
　Dim fso As Object
　Dim strPath As String
　Dim strFolder As Variant
　Dim i As Long, n As Long, j As Long, l As Long
　Dim a()
　Dim strFile As Variant
　Dim strPathExcel() As String
　Dim inFiles() As Variant
　Dim varFol As Variant
　Dim x As Long, y As Variant
　Dim ar2 As Variant
　'******ユーザー設定**********
　Const blnTXT As Boolean = False 'フォルダのテキスト比較
　strPath = "C:\Users\Temp\" 'ユーザーフォルダー
　'****************************
　'Cells.Clear 'シート全体を消す
　i = 0
　Set fso = CreateObject("Scripting.fileSystemObject")
　For Each strFolder In fso.getfolder(strPath).subfolders
　　ReDim Preserve a(i)
　　a(i) = strFolder.Path
　　i = i + 1
　Next strFolder
　
　Call Bubble_Sort(a(), blnTXT) 'バブルソート
　
　ReDim inFiles(UBound(a()), 1)
　
　For Each varFol In a()
　　For Each strFile In fso.getfolder(varFol).Files
　　　If InStr(strFile.Type, "Excel") > 0 Then
　　　　ReDim Preserve strPathExcel(l)
　　　　strPathExcel(l) = Dir(strFile.Path)
　　　　l = l + 1
　　　End If
　　Next strFile
　　inFiles(n, 0) = varFol
　　inFiles(n, 1) = strPathExcel()
　　n = n + 1
　　l = 0
　　Erase strPathExcel
　Next varFol
　i = 1: j = 1
　For x = 0 To UBound(inFiles)
　　Cells(i, 1).Value = inFiles(x, 0)
　　　
　　　ar2 = inFiles(x, 1)
　　　On Error Resume Next
　　　y = Empty
　　　y = UBound(ar2)
　　　On Error GoTo 0
　　　If Not IsEmpty(y) Then
　　　Cells(j, 2).Resize(y + 1).Value = Application.Transpose(ar2)
　　　j = i + UBound(ar2) + 1 + 1
　　　i = j
　　　End If
　Next x
End Sub
Sub Bubble_Sort(ByRef a(), Optional txt As Boolean = False)
'txt オプションは、text 比較の意味
　Dim u As Long
　Dim i As Long
　Dim j As Long
　Dim t As Variant
　Dim m As Variant, n As Variant
　u = UBound(a())
　i = LBound(a())
　Do While i < u
　　j = u
　　Do While j > i
　　 If txt Then
　　　m = Dir(a(j), vbDirectory)
　　　n = Dir(a(i), vbDirectory)
　　　Else
　　　m = Val(Dir(a(j), vbDirectory))
　　　n = Val(Dir(a(i), vbDirectory))
　　　End If
　　　If m < n Then　'判定　<昇順
　　　　t = a(i)
　　　　a(i) = a(j)
　　　　a(j) = t
　　　End If
　　　j = j - 1
　　Loop
　　i = i + 1
　Loop
End Sub

この回答へのお礼

コードを教えてくださりありがとうございました。ソートは勉強しなければいけないなと思いつつ関数に頼ってしまいます。試してみます。

お礼日時：2015/04/13 11:16