Excel VBA質問箱 IV

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

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


7974 / 76732 ←次へ | 前へ→

【74339】Re:Next で行まで初期化してしまうかどうか
発言  kanabun  - 13/5/24(金) 9:18 -

引用なし
パスワード
   ▼にしもり さん:

>確かに処理順がおかしいのでご教示いただいたMicrosoft Scripting Runtime の方法を使わせていただきました。
>希望通りに出来ました。

>サブディレクトリー名を表示しない方法についてもありがとうございました。
>ただサブディレクトリー名は表示させたいので実際には用いませんでした。

補足ですが、たとえば
C:\_cosmos\Tr フォルダの中が 以下のような構成になっているとき、

C:\_cosmos\Tr
  ┃
  ┣━ aaa
  ┃   111.xls
  ┃
  ┣━ bbb
  ┃   222.xls
  ┃
  ┗━ ccc
      333.xls


Fsoを使う方法

  Set oFolder = Fso.GetFolder("C:\_cosmos\Tr")
  FileSearch2 oFolder, 1 '2行目から書き出す

で FileSearch2 を呼び出しますと、

 [FileSearch2]
2  C:\_cosmos\Tr\aaa\111.xls
3  C:\_cosmos\Tr\bbb\222.xls
4  C:\_cosmos\Tr\ccc\333.xls

というファイルリストが出力されます。

(こういうリストが出力されればいいのですよね?)

ところが、(Fsoは遅いので) もっと高速に一覧を得ようとして

  n = SearchFiles("C:\_cosmos\Tr", "*.*", FoundFiles())

で Dirコマンドを呼び出すと、
----------------
    C:\_cosmos\Tr\aaa
    C:\_cosmos\Tr\bbb
    C:\_cosmos\Tr\ccc
    C:\_cosmos\Tr\aaa\111.xls
    C:\_cosmos\Tr\bbb\222.xls
    C:\_cosmos\Tr\ccc\333.xls

というファイル一覧が得られるのです。

こうなってしまうのは
Dirコマンドのオプションを

  sCmd = "DIR """ & Filename & """ /b/s/o:N > """ & tmpPath & """"

としていたからです。

 [FileSearch2]
と同様の結果が欲しいなら、オプションは

  sCmd = "DIR """ & Filename & """ /b/s/a:-D/o:N > """ & tmpPath & """"
           '' /b ファイル名のみ
           '' /s サブディレクトリも検索
           '' /a/:-D サブディレクトリー名は表示しない
           '' /o:N 名前順でソート
としなくてはいけません。

※なお、Dirコマンドの一時ファイル出力先を 対象フォルダ として
 いたのは、全ファイルが検索対象のときそれも表示され都合が悪かったので
 WindowsのTEMPフォルダ内に作成することにしました。
 参考のため、それを以下に再掲しておきます。

'//サブフォルダを含むファイルの一覧 【一時ファイル先 修正後】
Function SearchFiles(LookIn As String, Filename As String, _
          FoundFiles() As String) As Long
  Dim i As Long
  Dim Ext As Variant
  Dim tmpPath As String
  Dim sCmd As String
  Dim ko As Long
  
  If Right$(LookIn, 1) <> "\" Then LookIn = LookIn & "\"
  If InStr(Filename, ";") > 0 Then '複数ファイルタイプ対応
    Ext = Split(Filename, ";")  '例 "*.csv;*.xls"
    For i = 0 To UBound(Ext)
      Ext(i) = LookIn & Ext(i)
    Next
    Filename = Join(Ext, """ """)
  Else
    Filename = LookIn & Filename
  End If
  tmpPath = Environ$("TEMP") & "\Dir.tmp" '●一時ファイル出力先
  
  sCmd = "DIR """ & Filename & """ /b/s/a:-D/o:N > """ & tmpPath & """"
           '' /b ファイル名のみ
           '' /s サブディレクトリも検索
           '' /a/:-D サブディレクトリー名は表示しない●
           '' /o:N 名前順でソート
  With CreateObject("WScript.Shell")
    ko = .Run("CMD /C " & sCmd, 7, True) 'Dirコマンド実行
  End With
  If ko Then
    MsgBox "ファイルの検索に失敗しました", , LookIn
    Exit Function
  End If
  If FileLen(tmpPath) < 2 Then Exit Function
  
  Dim io As Integer
  Dim buf() As Byte
  io = FreeFile()
  Open tmpPath For Binary As io
   ReDim buf(1 To LOF(io))
   Get #io, , buf
  Close io
  Kill tmpPath
  FoundFiles() = Split(StrConv(buf, vbUnicode), vbCrLf)
  ko = UBound(FoundFiles)
  ReDim Preserve FoundFiles(ko - 1)
  SearchFiles = ko
  
End Function

0 hits

【74322】Next で行まで初期化してしまうかどうか にしもり 13/5/22(水) 19:16 質問
【74323】Re:Next で行まで初期化してしまうかどうか kanabun 13/5/22(水) 19:31 発言
【74324】Re:Next で行まで初期化してしまうかどうか kanabun 13/5/22(水) 23:46 発言
【74325】Re:Next で行まで初期化してしまうかどうか kanabun 13/5/22(水) 23:48 発言
【74336】Re:Next で行まで初期化してしまうかどうか kanabun 13/5/23(木) 20:08 発言
【74338】Re:Next で行まで初期化してしまうかどうか にしもり 13/5/24(金) 6:04 お礼
【74339】Re:Next で行まで初期化してしまうかどうか kanabun 13/5/24(金) 9:18 発言
【74326】Re:Next で行まで初期化してしまうかどうか kanabun 13/5/23(木) 0:41 発言
【74327】Re:Next で行まで初期化してしまうかどうか にしもり 13/5/23(木) 5:19 発言

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