Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


12945 / 13644 ツリー ←次へ | 前へ→

【7531】ファイル名とディレクトリ名を名前順に取得 もと 03/9/8(月) 11:16 質問
【7548】Re:ファイル名とディレクトリ名を名前順に取... しのしの 03/9/8(月) 15:51 回答
【7565】Re:ファイル名とディレクトリ名を名前順に取... もと 03/9/8(月) 17:06 発言
【7823】事後報告ですが・・・ もと 03/9/19(金) 10:10 お礼

【7531】ファイル名とディレクトリ名を名前順に取得
質問  もと  - 03/9/8(月) 11:16 -

引用なし
パスワード
   はじめまして。
最近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


長文になってしまいましたがよろしくお願い致します。

【7548】Re:ファイル名とディレクトリ名を名前順に...
回答  しのしの  - 03/9/8(月) 15:51 -

引用なし
パスワード
   もとさん、こんにちは。

個人的意見ですが、
ファイルを検索している最中に実際のマクロをするのではなく、
1.文字列配列に、該当ファイル名を格納する
2.1項の文字列配列を「指定順序」に並び替える
3.2項の文字列配列に対してマクロを実行する
というように変更したほうが良いと思います。

配列を取得する例を参考までに....
#すいません、例にFileSystemObjectをつかっているので、
#MicrosoftScriptiongRuntime参照設定してください。

うまくできるといいですね。

Private mobj As Scripting.FileSystemObject

Sub Main()
  Dim strpath As String
  Dim fld As Scripting.Folder
 
  Dim strFilename() As String  'ファイルパス格納配列
  Dim iIdx As Long
  
  Set mobj = New Scripting.FileSystemObject
  
  strpath = "C:\Home"
  Set fld = mobj.GetFolder(strpath)
  
  'ファイルパス格納配列初期化
  strFilename = VBA.Split("", ",")
  
  'ファイルパス格納配列にファイルパスを格納する
  Call getFileName(fld, strFilename)
  
  '該当するパスがなければ、処理を終了する
  If UBound(strFilename) = -1 Then Exit Sub
  
  '取得したファイル名をイミディエイトに出力
  '本来はここで、実行させるマクロを記述してください。
  For iIdx = LBound(strFilename) To UBound(strFilename)
    Debug.Print (strFilename(iIdx))
  Next

  Set mobj = Nothing

End Sub

Private Sub getFileName(ByRef rFolder As Scripting.Folder, _
  ByRef rStr() As String)
  Dim iFile  As Scripting.File
  Dim iFolder As Scripting.Folder
  
  '
  For Each iFile In rFolder.Files
  
    '検索条件にあうものだけを取得して下さい。
    'if Ifile.name = ”””-------- then
     ReDim Preserve rStr(UBound(rStr) + 1)
     rStr(UBound(rStr)) = iFile.Path & "\" & iFile.Name
    'End If
  Next

  '検索するのが2階層でいいなら、モジュールを書き直して下さい。
  'このままだと、一番最後の階層のファイルまで探しに行きます。
  For Each iFolder In rFolder.SubFolders
    Call getFileName(iFolder, rStr())
  Next

End Sub

【7565】Re:ファイル名とディレクトリ名を名前順に...
発言  もと  - 03/9/8(月) 17:06 -

引用なし
パスワード
   もとです。
しのしのさん早速の回答ありがとうございます。


>個人的意見ですが、
>ファイルを検索している最中に実際のマクロをするのではなく、
>1.文字列配列に、該当ファイル名を格納する
>2.1項の文字列配列を「指定順序」に並び替える
>3.2項の文字列配列に対してマクロを実行する
>というように変更したほうが良いと思います。

 なるほど。検索後に一括処理をするようにしてみます。


>#すいません、例にFileSystemObjectをつかっているので、
>#MicrosoftScriptiongRuntime参照設定してください。

 FileSystemObjectというものを初めて知ったので少し勉強してから
 しのしのさんのプログラムを参考にしてみます。


>うまくできるといいですね。

 ありがとうございます。頑張ってみます。
 また報告いたします。
 

【7823】事後報告ですが・・・
お礼  もと  - 03/9/19(金) 10:10 -

引用なし
パスワード
   報告が大変遅くなりましてすいません。
少し別件で立てこんでいたもので遅くなってしまいました^^;

しのしのさんのお考え通りかどうかはわかりませんが、
マクロでファイル検索結果をセルに書き出したあとに、ソートして
その結果を取り込み処理を実行させるようにして問題は無事解決しました。

しのしのさん、その他色々考えてくださった皆さんありがとうございました。
またお世話になるかもしれませんが、そのときはよろしくお願い致します。

以上。

12945 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free