Excel VBA質問箱 IV

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

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


23889 / 76732 ←次へ | 前へ→

【58198】再帰処理でのファイル検索
質問  ON  - 08/10/10(金) 19:56 -

引用なし
パスワード
   こんにちは よろしくお願いします

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

以前、高速なAPIで、フォルダ、ファイルの検索を教えて頂いた方法
(セルやイミディエイトウインドウに出力)
を、利用できないものかとチャレンジしましたがうまくいきません

やりたいことは
ファイルサーバーの所定のフォルダ配下には
重複するファイル名が存在しないことになっているのですが
時折、ファイルコピー等あったりして、キーで検索しても
複数存在したり、無かったりするものがあります

で、1ファイルだけの存在した場合場合、正常処理、そうでない場合は
メッセージを出したいと考えています


APIでの不具合の原因は、
他書への出力の場合は問題はないのですが
再帰のため戻り値や、配列に入れても最後の値しか取得できません

戻り値や配列の値が1つであれば
それを元に処理したいと考えています


APIはコピペ程度でしか利用できないレベルです
また、アプローチがおかしいような気もしています
ご教授よろしくお願い致します


下記は
配列を公開で宣言してそこに値を貯めこもうと考えました


Option Explicit
Option Compare Text


Private Type WIN32_FIND_DATAW
  dwFileAttributes As Long
  ftCreationTime(0 To 1) As Long
  ftLastAccessTime(0 To 1) As Long
  ftLastWriteTime(0 To 1) As Long
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0  As Long
  dwReserved1  As Long
  cFileName(0 To 519) As Byte
  cAlternateFileName(0 To 27) As Byte
End Type
Private Declare Function FindFirstFileW Lib "kernel32" _
    (lpFileName As Any, _
    lpFindFileData As WIN32_FIND_DATAW) As Long
Private Declare Function FindNextFileW Lib "kernel32" _
    (ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATAW) As Long
Private Declare Function FindClose Lib "kernel32" _
    (ByVal hFindFile As Long) As Long

Dim HAIRETSU() As String


' ファイルの検索 (NT系OS専用)
Sub SearchFiles3(ByVal strDir As String, strFind As String)

  Static wfd As WIN32_FIND_DATAW
  Dim strName As String
  Dim hFile As Long
  
  Dim I As Integer
  
  Dim TG_PATH As String
  
  I = 0
  TG_PATH = ""
  'GET_I = 0
  'GET_PATH = ""

  If StrComp(Right$(strDir, 1), "\", vbBinaryCompare) <> 0 Then
    strDir = strDir & "\"
  End If

  ' フォルダ(strDir)内の1件目を取得
  hFile = FindFirstFileW(ByVal StrPtr(strDir & "*"), wfd)
  If hFile = INVALID_HANDLE_VALUE Then
    ' この下の3行は消してもかまわない
    If Err.LastDllError = ERROR_CALL_NOT_IMPLEMENTED Then
      MsgBox "このOSでは動きません。", vbCritical
    End If
    Exit Sub
  End If

  Do
    ' ファイル(orフォルダ)名の取得
    strName = wfd.cFileName
    strName = Left$(strName, InStr(1, _
          strName, vbNullChar, vbBinaryCompare) - 1)

    'フォルダパス・ファイル部分一致
    If strName Like "*" & strFind & "*" Then
    '  Debug.Print strDir & strName
      TG_PATH = strDir & strName
      I = I + 1
    '  Debug.Print I
      
      ReDim HAIRETSU(I)
      HAIRETSU(I) = strDir & strName

    End If
    

    ' 属性の判定
    If wfd.dwFileAttributes And vbDirectory Then
      ' フォルダの場合
      If StrComp(strName, ".", vbBinaryCompare) <> 0 Then
       If StrComp(strName, "..", vbBinaryCompare) <> 0 Then
        ' 再帰呼び出し
        SearchFiles3 strDir & strName, strFind
        
       End If
      End If


    End If

  ' 引き続き2件目以降を取得 (全件取得するまでループ)
  Loop While FindNextFileW(hFile, wfd)

  ' ハンドルを閉じる
  FindClose hFile
  
  
  If I = 1 Then
    Debug.Print "正"
    Debug.Print TG_PATH
  
  ElseIf I > 1 Then
    Debug.Print "重複不整合"
    
  'ループ分実行されてしまう
  'Else
    'Debug.Print "無し"

  End If


End Sub


Public Sub test()


Call SearchFiles3("\\hoge", "huga")


Debug.Print HAIRETSU(1)
Debug.Print UBound(HAIRETSU)


End Sub
1 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 お礼

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