| |
はじめまして。
最近VBAを触るようになりまして、時々掲示板を拝見しお世話になっております。
今回どうしてもできないことがあって質問させていただくことになりました。
Excel2000を使用しているのですが、
目的は指定したディレクトリ配下のサブディレクトリも含む全てのファイル名を
取得することなのですが、DIR関数を用いて行ったところ、始めはファイル名順に
取得されていた名前が、最近理解のできない順番で取得されるようになりました。
インターネットなどで調べてFileSearchオブジェクトなどを用いてやると
ファイル名順には検索できるのですが、今度はディレクトリを無視したﾌｧｲﾙ名
順で検索されてしまいます。
わかりにくいかもしれませんが例をあげますと、
D:\test\01\a.xls
\b.xls
\c.xls
\02\001.xls
\002.xls
\03\0001.xls
\0002.xls
みたいな順番でファイル名及びディレクトリ名を取得していきたいのですが、
（最終的にはこの順番でさまざまな処理を行いたいので）
何かよい方法はありますでしょうか？
念のため現在の方法を下に挙げておきます。
・DIR関数を用いた方法
'========================================
'
'MAIN
'
'========================================
Call Get_DIR(指定パス)
'=======================================
'
'ﾌｫﾙﾀﾞ検索
'
'=======================================
Function Get_DIR(MyPath As String)
Dim MyName As String
Dim DirName(256)
Dim Dir_N As Long
Dim i As Long
On Error GoTo err_hdl
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
GetFile (MyPath)
Dir_N = 0
MyName = Dir(MyPath, vbDirectory) ' 最初のフォルダ名
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then '現在のフォルダと親フォルダは無視
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then ' ビット単位の比較を行う
Dir_N = Dir_N + 1
DirName(Dir_N) = MyPath + MyName
End If
End If
MyName = Dir '次のフォルダを検索
Loop
If Dir_N > 0 Then
For i = 1 To Dir_N
Get_DIR (DirName(i) + "\")
Next i
End If
err_hdl:
If Err = 53 Then
MsgBox (DirName(i) + " file not found")
End If
End Function
'======================================================
'
'ファイル名の取得
'
'======================================================
Function GetFile(MyPath As String)
Dim MyName As String
Dim No As Integer
Dim a As Integer
Dim WS_CT As Integer
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
MyName = Dir(MyPath & "\*.xls", vbNormal) ' 最初のfile名
Do While MyName <> "" ' ループを開始
'現在のフォルダと親フォルダは無視
If MyName <> "." And MyName <> ".." And MyName <> "試作マクロ.xls" Then
' ビット単位の比較を行う
If (GetAttr(MyPath & MyName) And vbNormal) = vbNormal Then
'ﾌｧｲﾙごとに行う実際の処理
End If
End If
MyName = Dir
Loop
End function
・FileSearchオブジェクトを用いた方法
With Application.FileSearch
.LookIn = CUR_PATH '検索するフォルダを指定
.SearchSubFolders = True 'サブフォルダも検索対象にする
.Filename = "*.xls" 'Excleﾌｧｲﾙの全てを検索
.FileType = msoFileTypeExcelWorkbooks '検索対象はエクセルブック
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then 'ﾌｧｲﾙの名前でソート
MsgBox .FoundFiles.Count & " 個のExcelブックが見つかりました"
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> CUR_PATH & "試作マクロ.xls" Then '無視
If (GetAttr(MyPath & .FoundFiles(i)) And vbNormal) = vbNormal Then ' ビット単位の比較を行う
'実際のﾌｧｲﾙ毎の処理
End If
End If
Next i
Else
MsgBox "Excelﾌｧｲﾙは存在しません。"
End If
End With
長文になってしまいましたがよろしくお願い致します。
|
|
