華VBAフォルダサイズサブフォルダ数ファイル数取得

Private Sub CommandButton1_Click()
'Call getFolderSize
'Call GetFileCount
Dim subfolderscount As Integer

subfolderscount = GetSubFolserCount("C:\Users\huawe\OneDrive\デスクトップ\週間作業報告書")
If subfolderscount <> 0 Then
GetFileCountSaiki
End If



End Sub


'フォルダサイズ取得
Public Sub getFolderSize()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
''C:\Workフォルダ内の全ファイルの合計サイズを表示します
MsgBox fso.GetFolder("C:\Drivers").Size / 1024 / 1024 / 1024
Set fso = Nothing

End Sub

'ファイル数取得 :再帰あり
Public Sub GetFileCountSaiki()
'--- 含まれるフォルダ数を知りたいフォルダのパス ---'
Dim folderPath As String
'folderPath = "C:\Drivers"
folderPath = "C:\Users\huawe\OneDrive\デスクトップ\週間作業報告書"
'--- サブフォルダパス一覧を格納する変数 ---'
Dim subFolders() As String
subFolders = GetFolderPath(folderPath)
'--- ファイルシステムオブジェクト ---'
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
'--- ファイル数を格納する変数 ---'
Dim n As Long
n = fso.GetFolder(folderPath).Files.Count
'--- サブフォルダ内のファイル数を加算 ---'
Dim tmp As Variant
For Each tmp In subFolders
n = n + fso.GetFolder(tmp).Files.Count
Next tmp
MsgBox "ファイル数:" & n & " " & "子フォルダ数:" & UBound(subFolders)

End Sub

 

'--- サブフォルダを再帰的に取得する関数 ---'
Public Function GetFolderPath(folderPath As String) As String()
'--- ファイルシステムオブジェクト ---'
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
'--- フォルダ数を格納する変数 ---'
Dim n As Variant
n = fso.GetFolder(folderPath).subFolders.Count
If (0 < n) Then
'--- フォルダパスを格納する配列 ---'
Dim str() As String
ReDim str(1 To n)
'--- フォルダパスを格納 ---'
Dim i As Long
Dim j As Long
Dim m As Long
i = 1
Dim strTmp() As String
'フォルダパスを指定してすべてのサブフォルダを取得
Dim f As Object
For Each f In fso.GetFolder(folderPath).subFolders
str(i) = f.Path
strTmp = GetFolderPath(str(i)) '再帰的呼び出し
If (Not IsEmptyArray(strTmp)) Then
m = UBound(strTmp, 1)
Else
m = 0
End If
'サブフォルダ内にさらにフォルダがあればその分だけ配列を拡張
n = UBound(str, 1)
ReDim Preserve str(1 To n + m)
For j = 1 To m
str(i + j) = strTmp(j)
Next j
i = i + m + 1
Next f
End If
GetFolderPath = str
End Function

'サブフォルダ数
Public Function GetSubFolserCount(folderPath As String) As Integer
'--- ファイルシステムオブジェクト ---'
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
'--- フォルダ数を格納する変数 ---'
Dim n As Integer
n = fso.GetFolder(folderPath).subFolders.Count
GetSubFolserCount = n

End Function

'--- 配列が空かどうかを判定する関数 ---'
Public Function IsEmptyArray(arrayTmp As Variant) As Boolean
On Error GoTo ERROR_
If (0 < UBound(arrayTmp, 1)) Then
IsEmptyArray = False
End If
Exit Function
ERROR_:
IsEmptyArray = True
End Function

posted on 2021-04-13 22:04  IT初学者骂蕾  阅读(169)  评论(0编辑  收藏  举报

导航