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