Excel VBA質問箱 IV

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

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


48370 / 76732 ←次へ | 前へ→

【33298】Re:外部ファイルの条件選択について
回答  Hirofumi  - 06/1/7(土) 21:52 -

引用なし
パスワード
   現在の「Private Function GetFileNames」を削除して
以下の2つのプロシージャと差し替えて下さい

Private Function GetFileNames(vntFileNames As Variant, _
              strFolderPath As String, _
              objFSO As Object, _
              Optional strBasePattan As String = ".*", _
              Optional strExtePattan As String = ".*", _
              Optional lngSubDir As Long = -1) As Boolean
              
  Const clngLower As Long = 0
  
  Dim regName As Object
  Dim vntRead As Variant
  
  'フォルダの存在確認
  If Not objFSO.FolderExists(strFolderPath) Then
    GoTo Wayout
  End If
  
  Set regName = CreateObject("VBScript.RegExp")
  '大文字と小文字を区別しないように設定
  regName.IgnoreCase = True

  'ファイル名List配列の初期化
  ReDim vntRead(1, clngLower To 1)
  'ファイル名Listの作成
  GetFilePath vntRead, _
        objFSO.GetFolder(strFolderPath), _
        strBasePattan, strExtePattan, _
        regName, objFSO, lngSubDir
  
  'ファイル名List配列の先頭値が""で無いなら
  If vntRead(0, clngLower) <> "" Then
    vntFileNames = vntRead
    GetFileNames = True
  End If
  
Wayout:
  
  Set regName = Nothing

End Function

Private Sub GetFilePath(vntFileNames As Variant, _
            objFolder As Object, _
            strBasePattan As String, _
            strExtePattan As String, _
            regName As Object, _
            objFSO As Object, _
            ByVal lngSubDir As Long)

  Dim lngLower As Long
  Dim i As Long
  Dim objFile As Object
  Dim objSubDir As Object
  Dim strDirPath As String
  Dim strName As String
  
  'List配列の最小添え字を取得
  lngLower = LBound(vntFileNames, 2)
  'List配列に値が有る場合
  If vntFileNames(0, lngLower) <> "" Then
    'カウンタをList配列の最大添え字に設定
    i = UBound(vntFileNames, 2)
  Else
    'カウンタをList配列の最小添え字以下に設定
    i = lngLower - 1
  End If
  
  '現在のFoderPathを取得
  strDirPath = objFolder.Path & "\"
  'ファイル名を列挙
  For Each objFile In objFolder.Files
    strName = objFile.Name
    With regName
      '拡張子を比較
      .Pattern = strExtePattan
      If .TEST(objFSO.GetExtensionName(strName)) Then
        'Base名を比較
        .Pattern = strBasePattan
        If .TEST(objFSO.GetBaseName(strName)) Then
          'カウンタをインクリメント
          i = i + 1
          'List配列を拡張
          ReDim Preserve vntFileNames(1, lngLower To i)
          'Path、ファイル名を代入
          vntFileNames(0, i) = strDirPath
          vntFileNames(1, i) = strName
        End If
      End If
    End With
  Next objFile

  Set objFile = Nothing
  
  '指定階層数になるまで再帰、lngSubDir < 0 の時は最終階層まで再帰
  If lngSubDir > 0 Or lngSubDir < 0 Then
    '階層指定を一つ下げる
    lngSubDir = lngSubDir - 1
    'SubFolderを探索
    For Each objSubDir In objFolder.SubFolders
      GetFilePath vntFileNames, objSubDir, _
            strBasePattan, strExtePattan, _
            regName, objFSO, lngSubDir
    Next objSubDir
  End If
  
  Set objSubDir = Nothing
  
End Sub

後、呼び出し側の「Private Function GetFilesList」に就いて
もし、指定Folrder以下のSubFolrder全てなら、「Private Function GetFilesList」を
変更せず其のままで出来ます
また、指定Folrderの直ぐ下のFolderまでなら以下の様に変更して下さい

「Private Function GetFilesList」の中の

  '指定形式のファイル名を取得
  strCompe = "^[0-9][0-9][01][0-9][0-3][0-9]$|^[0-9][0-9][01][0-9][0-3][0-9]_[0-9]+$"
  If Not GetFileNames(vntFiles, strPath, objFso, strCompe, "txt") Then
    GoTo Wayout
  End If



  '指定形式のファイル名を取得
  strCompe = "^[0-9][0-9][01][0-9][0-3][0-9]$|^[0-9][0-9][01][0-9][0-3][0-9]_[0-9]+$"
  If Not GetFileNames(vntFiles, strPath, objFso, strCompe, "txt", 1) Then
    GoTo Wayout
  End If

にする
新しい、「Private Function GetFileNames」は、引数が1つ増え、
最後の引数がSubFolderの階層を指定しています
意味は、0=指定Folder、1=指定Folder因り1つ下まで、2=指定Folder因り2つ下まで、・・・
尚、ここに-1を指定するか、何も指定しない場合、
指定Folder以下全てのSubFilderが対象と成ります

尚、このコードは、再帰呼び出しを使って居ますので
多分相当遅く成ると思います
また、再帰の常で、余り深い階層に成るとスッタクオーバーと成りますので、
気を就けて下さい
ただ、Win98でも3〜4層した程度なら使えると思います
(WinXP、Win2000のOSならもっと下まででも行けると思いますが、
くれぐれも、「C:\以下全て」の様な使い方をし無い方が無難です)
0 hits

【33137】外部ファイルの条件選択について みり 06/1/3(火) 15:59 質問
【33138】Re:外部ファイルの条件選択について かみちゃん 06/1/3(火) 16:07 発言
【33139】Re:外部ファイルの条件選択について かみちゃん 06/1/3(火) 16:23 回答
【33157】Re:外部ファイルの条件選択について Hirofumi 06/1/3(火) 19:52 回答
【33174】Re:外部ファイルの条件選択について みり 06/1/4(水) 16:20 質問
【33179】Re:外部ファイルの条件選択について Hirofumi 06/1/4(水) 17:32 回答
【33184】Re:外部ファイルの条件選択について みり 06/1/4(水) 18:24 質問
【33188】Re:外部ファイルの条件選択について Hirofumi 06/1/4(水) 18:44 発言
【33196】Re:外部ファイルの条件選択について Hirofumi 06/1/4(水) 20:38 回答
【33198】Re:外部ファイルの条件選択について Hirofumi 06/1/4(水) 20:45 発言
【33297】Re:外部ファイルの条件選択について みり 06/1/7(土) 19:00 質問
【33298】Re:外部ファイルの条件選択について Hirofumi 06/1/7(土) 21:52 回答

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