Excel VBA質問箱 IV

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

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


48472 / 76732 ←次へ | 前へ→

【33196】Re:外部ファイルの条件選択について
回答  Hirofumi  - 06/1/4(水) 20:38 -

引用なし
パスワード
   前の「Function GetFilesList」を削除して
以下の2つのプロシージャと入れ替えてください
ただし、ファイル名の抽出は遅く成ると思います

Private Function GetFilesList(vntFilenames As Variant, _
                strPath As String, _
                vntMark As Variant) As Boolean
  
'  Fso使用版
  
  Dim i As Long
  Dim j As Long
  Dim vntRead() As Variant
  Dim strName As String
  Dim lngPos As Long
  Dim vntStart As Variant
  Dim vntFinish As Variant
  Dim lngCount As Long
  Dim vntFiles As Variant
  Dim strCompe As String
  Dim objFso As Object
  
  vntMark = Trim(vntMark)
  lngPos = InStr(1, vntMark, "〜", vbBinaryCompare)
  If lngPos = 0 Then
    GoTo Wayout
  End If
  '開始日付の取得
  vntStart = Left(vntMark, lngPos - 1)
  If IsDate(vntStart) Then
    vntStart = DateValue(vntStart)
  Else
    GoTo Wayout
  End If
  '終了日付の取得
  vntFinish = Mid(vntMark, lngPos + 1)
  If IsDate(vntFinish) Then
    vntFinish = DateValue(vntFinish)
    vntFinish = DateSerial(Year(vntFinish), _
                Month(vntFinish) + 1, 0)
  Else
    Exit Function
  End If
    
  'FSOのオブジェクトを取得
  Set objFso = CreateObject("Scripting.FileSystemObject")
     
  '指定形式のファイル名を取得
  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

  'ファイル名の比較
  For i = vntStart To vntFinish
    '比較パターンを作成
    strName = Format(i, "yymmdd") & "*"
    '抽出したファイル名と比較
    For j = 1 To UBound(vntFiles)
      If objFso.GetBaseName(vntFiles(j)) Like strName Then
        lngCount = lngCount + 1
        ReDim Preserve vntRead(1 To lngCount)
        vntRead(lngCount) = vntFiles(j)
      End If
    Next j
  Next i
  
  'ファイルの数が0でなければ
  If lngCount > 0 Then
    vntFilenames = vntRead
    GetFilesList = True
  End If
  
Wayout:

  Set objFso = Nothing

End Function

Private Function GetFileNames(vntFilenames As Variant, _
              strFilePath As String, _
              objFso As Object, _
              Optional strNamePattan As String = ".*", _
              Optional strExtePattan As String = ".*") As Boolean

  Dim i As Long
  Dim objFiles As Object
  Dim objFile As Object
  Dim regExten As Object
  Dim regName As Object
  Dim vntRead() As Variant
  Dim strName As String

  'フォルダの存在確認
  If Not objFso.FolderExists(strFilePath) Then
    GoTo Wayout
  End If

  'regExtenpのオブジェクトを取得(正規表現を作成)
  Set regExten = CreateObject("VBScript.RegExp")
  With regExten
    'パターンを設定
    .Pattern = strExtePattan
    '大文字と小文字を区別しないように設定
    .IgnoreCase = True
  End With
  Set regName = CreateObject("VBScript.RegExp")
  With regName
    'パターンを設定
    .Pattern = strNamePattan
    '大文字と小文字を区別しないように設定
    .IgnoreCase = True
  End With

  'フォルダオブジェクトを取得
  Set objFiles = objFso.GetFolder(strFilePath).Files

  'ファイルの数が0でなければ
  If objFiles.Count <> 0 Then
    For Each objFile In objFiles
      With objFile
        strName = .Name
        '検索をテスト
        If regExten.TEST(objFso.GetExtensionName(strName)) Then
          If regName.TEST(objFso.GetBaseName(strName)) Then
            i = i + 1
            ReDim Preserve vntRead(1 To i)
            vntRead(i) = strName
          End If
        End If
      End With
    Next objFile
  End If

  Set regExten = Nothing
  Set regName = Nothing

  If i <> 0 Then
    ReDim vntFilenames(1 To UBound(vntRead))
    For i = 1 To UBound(vntRead)
      vntFilenames(i) _
        = StrConv(strFilePath & "\" & vntRead(i), vbNarrow)
    Next i
    GetFileNames = True
  End If

Wayout:

  'フォルダオブジェクトを破棄
  Set objFiles = Nothing
  Set objFile = Nothing

End Function

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 回答

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