VBAプロシージャ集2

FilePath.bas

'---------------------------------------------------------------------
'  ファイルパスユーティリティ
'---------------------------------------------------------------------
Option Explicit

Private ResultArray()
Private RecursionFlag
Private GlobalFSO As Object
Private IncludeFolderResult
Private DenyFolderNames
Private AllowExtensionNames

Public Function GFSO()
    If GlobalFSO Is Nothing Then
        Set GlobalFSO = CreateObject("Scripting.FileSystemObject")
    End If
    Set GFSO = GlobalFSO
End Function

Public Function GetFilePathArray(aFolderPath, _
    Optional aRecursionFlag = False, Optional aIncludeFolderResult = True, _
    Optional aAllowExtensionNames = "", Optional aDenyFolderNames = "")

    ResultArray = Array()
    IncludeFolderResult = aIncludeFolderResult
    RecursionFlag = aRecursionFlag
    DenyFolderNames = aDenyFolderNames
    AllowExtensionNames = aAllowExtensionNames
    CrawlFolder GFSO.getfolder(aFolderPath)
    GetFilePathArray = ResultArray
End Function

Private Sub CrawlFolder(aParentFolder As Object)
    If RecursionFlag Then
        Dim folder As Object
        For Each folder In aParentFolder.subfolders
        
            If ExistWord(DenyFolderNames, folder.Name) Then
                GoTo continue1
            End If

            If IncludeFolderResult Then
                Dim folderAttrs(1) As String
                folderAttrs(0) = FFP(folder.path)
                folderAttrs(1) = folder.DateLastModified
                AddArray ResultArray, folderAttrs
            End If
            
            CrawlFolder folder
        
continue1:
        Next
    End If
    Dim file
    For Each file In aParentFolder.Files
    
        If AllowExtensionNames <> "" And Not ExistWord(AllowExtensionNames, GFSO.GetExtensionName(file.Name)) Then
            GoTo continue2
        End If
    
    
        Dim fileAttrs(1) As String
        fileAttrs(0) = file.path
        fileAttrs(1) = file.DateLastModified
        AddArray ResultArray, fileAttrs

continue2:
    Next

End Sub

Private Function ExistWord(aCommaString, aKeyWord)
    ExistWord = False
    Dim wordArray
    wordArray = Split(aCommaString, ",")
    Dim word
    For Each word In wordArray
        If word = aKeyWord Then
            ExistWord = True
            Exit Function
        End If
    Next
End Function

'コード例
Private Sub sample()

    Dim arr
    arr = GetFilePathArray("c:\dummyfolder", True, False, "conf", "global,base,pg_log")
    
    ScanAllFile arr, ".*abc.*"

End Sub
Private Sub ScanAllFile(ByRef fileArray, aRegExpStr As String)
    
    For Each file In fileArray
    
        Dim recs
        recs = ReadFile(file(0), 1)
        
        Dim ms As Object
        Set ms = RegExp(Join(recs, vbCrLf), aRegExpStr)
        Dim m
        For Each m In ms

            Debug.Print file(0)
            Debug.Print m.Value

        Next
    
    Next

End Sub

Public Sub CreateZipBy7z(pZipPath As String, pEntryPathArray() As String)

    Dim exePath As String
    exePath = """C:\Program Files\7-Zip\7z.exe"""
    
    Dim targetPath As String
    targetPath = Join(pEntryPathArray, " ")
   
    Dim cmd As String
    cmd = exePath & " a " & pZipPath & " " & targetPath
    Debug.Print cmd
 
    
    result = execCommand(cmd, 0, True)

    Debug.Print result

End Sub