Excel VBA質問箱 IV

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

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


23892 / 76738 ←次へ | 前へ→

【58202】Re:再帰処理でのファイル検索
発言  kanabun  - 08/10/11(土) 11:13 -

引用なし
パスワード
   ▼ON さん:

>Application.FileSearch
>でのフォルダ、ファイルの検索が遅いので

それに、最新版Excel2007では、いまのところ使えないですしね(-_-)

>ファイルサーバーの所定のフォルダ配下には

以下のサンプルの
> Sub Try_FindFile()
内の
>  myPath = "D:\(Data)"
>  strFind = "abc.*"
を、
ファイルサーバーへのパスと 検索したいファイル名に置き換えて
お試しください。

P.S. 前日投稿した Sub Try_Start()の検索法は
  無駄があったので、削除しました。(もし前回投稿したものと
  スピードを比較されたいのでしたら、2つのモジュールは別Bookにて
  検証願います)
> Sub Try_FindFile()
では、2Stepで、
(1) 最初に指定フォルダのファイルを検索し、
(2) つぎに、サブフォルダの検索を行い、各SubFolder内を再帰呼び出しし、
   同名のファイルを検索しています。

'-------------------------------------
Option Explicit

Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = (-1)

' WIN32_FIND_DATA構造体
Private Type WIN32_FIND_DATA
  dwFileAttributes  As Long
  ftCreationTime   As Currency
  ftLastAccessTime  As Currency
  ftLastWriteTime   As Currency
  nFileSizeHigh    As Long
  nFileSizeLow    As Long
  dwReserved0     As Long
  dwReserved1     As Long
  cFileName(1 To MAX_PATH * 2) As Byte 'Unicode
  cAlternate(1 To 14 * 2) As Byte    'Unicode
End Type


Private Declare Function FindFirstFile _
       Lib "kernel32" Alias "FindFirstFileW" _
        (ByVal lpFileName As Long, _
        lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile _
       Lib "kernel32" Alias "FindNextFileW" _
         (ByVal hFindFile As Long, _
         lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose _
       Lib "kernel32" _
         (ByVal hFindFile As Long) As Long

' ファイルの属性
Private Const fATTR_READONLY  As Long = &H1
Private Const fATTR_HIDDEN   As Long = &H2
Private Const fATTR_SYSTEM   As Long = &H4
Private Const fATTR_DIRECTORY As Long = &H10
Private Const fATTR_ARCHIVE  As Long = &H20
Private Const fATTR_NORMAL   As Long = &H80

'-------------------------------------------------------------

Sub Try_FindFile()
  Dim myPath As String
  Dim strFind As String
  Dim f As String
  Dim n&
  Dim myList() As String

  myPath = "D:\(Data)"
  strFind = "abc.*"
  FindFile myPath, strFind, myList(), n '★呼び出し
  
  If n Then
    MsgBox Join(myList, vbCr), , strFind & " ---> " & n & " Files"
  Else
    MsgBox "該当ファイルなし"
  End If
  
End Sub


Private Sub FindFile(Pathname$, strFind$, myList$(), _
           fCount&, Optional SearchChild As Boolean = True)
 Dim p As String
 Dim fDATA As WIN32_FIND_DATA
 Dim lngAttribute As Long
 Dim f As String
 Dim hFile As Long
 Dim SubDirs() As String, nSub As Long, i As Long

 If Right$(Pathname, 1) <> "\" Then Pathname = Pathname & "\"
 strFind = LCase$(strFind)
 
 'まず 指定パス 直下の ファイルstrFindの検索をおこなう
  lngAttribute = fATTR_NORMAL Or _
          fATTR_READONLY Or _
          fATTR_SYSTEM Or _
          fATTR_HIDDEN Or _
          fATTR_ARCHIVE
  fDATA.dwFileAttributes = lngAttribute
 
 p = Pathname & strFind
 hFile = FindFirstFile(StrPtr(p), fDATA)
 If hFile = INVALID_HANDLE_VALUE Then Exit Sub
 Do
   f = fDATA.cFileName
   f = Left$(f, InStr(f, vbNullChar) - 1)
   If (fDATA.dwFileAttributes And vbDirectory) = 0 Then 
     fCount = fCount + 1
     ReDim Preserve myList(1 To fCount)
     myList(fCount) = Pathname & f
   End If
 Loop While FindNextFile(hFile, fDATA)
 FindClose hFile
 
 'つぎに 指定パス 内のサブフォルダの検索をおこなう
 If SearchChild Then
   p = Pathname & "*.*"
   fDATA.dwFileAttributes = fATTR_DIRECTORY
   hFile = FindFirstFile(StrPtr(p), fDATA)
   If hFile = INVALID_HANDLE_VALUE Then Exit Sub
   Do
     f = fDATA.cFileName
     f = Left$(f, InStr(f, vbNullChar) - 1)
     If (fDATA.dwFileAttributes And vbDirectory) Then
       If Left$(f, 1) <> "." Then
         nSub = nSub + 1
         ReDim Preserve SubDirs(1 To nSub)
         SubDirs(nSub) = Pathname & f
       End If
     End If
   Loop While FindNextFile(hFile, fDATA)
   FindClose hFile
 
   If nSub Then
     For i = 1 To nSub
       FindFile SubDirs(i), strFind, myList(), fCount
     Next
   End If
 End If

End Sub

0 hits

【58198】再帰処理でのファイル検索 ON 08/10/10(金) 19:56 質問
【58199】Re:再帰処理でのファイル検索 マクロマン 08/10/10(金) 20:37 発言
【58202】Re:再帰処理でのファイル検索 kanabun 08/10/11(土) 11:13 発言
【58203】Re:再帰処理でのファイル検索 kanabun 08/10/11(土) 11:29 発言
【58227】Re:再帰処理でのファイル検索 熊谷隆史 08/10/12(日) 16:24 発言
【58232】Re:再帰処理でのファイル検索 ON 08/10/12(日) 23:19 お礼
【58236】Re:再帰処理でのファイル検索 ON 08/10/13(月) 9:52 質問
【58250】Re:再帰処理でのファイル検索 熊谷隆史 08/10/14(火) 15:43 発言
【58251】Re:再帰処理でのファイル検索 kanabun 08/10/14(火) 17:39 発言
【58252】Re:再帰処理でのファイル検索 neptune 08/10/14(火) 21:41 発言
【58253】Re:再帰処理でのファイル検索 kanabun 08/10/14(火) 22:15 発言
【58255】Re:再帰処理でのファイル検索 neptune 08/10/14(火) 22:48 発言
【58256】Re:再帰処理でのファイル検索 jet 08/10/14(火) 23:41 回答
【58239】Re:再帰処理でのファイル検索 kanabun 08/10/13(月) 13:55 発言
【58243】Re:再帰処理でのファイル検索 neptune 08/10/13(月) 22:25 発言
【58244】Re:再帰処理でのファイル検索 kanabun 08/10/14(火) 1:25 発言
【58261】Re:再帰処理でのファイル検索 ON 08/10/15(水) 13:25 お礼
【58263】Re:再帰処理でのファイル検索 熊谷隆史 08/10/15(水) 13:43 発言
【58271】Re:再帰処理でのファイル検索 ON 08/10/15(水) 19:40 お礼
【58333】Re:再帰処理でのファイル検索 熊谷隆史 08/10/20(月) 10:47 発言
【58871】Re:再帰処理でのファイル検索 ON 08/11/15(土) 0:23 お礼

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