0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

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

Posted at

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

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?