[[20140426211455]]　『フォルダのサイズを取得する』（田吾作）　ページの最後に飛ぶ

『フォルダのサイズを取得する』（田吾作）

 下記のコードのようなマクロでフォルダの名前等の情報を取得し配列に格納しています。

 フォルダのサイズが大きい場合はエラーになってしまうようです。
 "C:\Windows\System32"は3.15GB程度ですが、マクロを実行したら
   ary(3, 0) = objfol.Size
 の箇所で

 実行時エラー '70':
 書き込みできません。

 というエラーになってしまいます。

 ary(3, 0) = (objfol.Size / 1024) / 1024
 と変えても同じエラーになります。
 フォルダサイズが大きくてもフォルダサイズを取得するにはそのように書き換えたらいいでしょうか？
 ご指導お願いいたします。

 Sub test()
  Dim ary() As Variant
  Dim fol As String
  Dim FSO As Object
  Dim objfol As Object
   Set FSO = CreateObject("Scripting.FileSystemObject")
   fol = "C:\Windows\System32"
   Set objfol = FSO.getfolder(fol)
   ReDim ary(3, 0)
   ary(0, 0) = objfol.Name
   ary(1, 0) = objfol.datecreated
   ary(2, 0) = objfol.datelastmodified
   ary(3, 0) = objfol.Size
   ActiveCell.Resize(4, 1).Value = ary
   Erase ary
   Set objfol = Nothing
   Set FSO = Nothing
 End Sub

＜使用 Excel：Excel2007、使用 OS：Windows Vista ＞

 これは EXCEL の問題ではなく、FSO の問題です。
 フォルダに限らず 2GB を超えるサイズは取得できないようです。
（Mook） 2014/04/26(土) 21:47

 Mookさん、ご回答ありがとうございます。
 承知いたしました。
 ありがとうございました。
（田吾作） 2014/04/26(土) 22:53

 以下は私の独り言です。

 フォルダサイズを直接取得するのではなく、再帰処理でファイルサイズを取得していって合計する、という
 方法でやってみました。

 "C:\Windows\System32"は中にアクセスできないフォルダがあり、そのフォルダのところでエラーになりました。
 そこで、他のフォルダに変えて実行したところ、今度はファイルパスの文字数が多いとやはりエラーになりました。

 今のところ、"C:\Windows\System32"は処理対象から外したので当初のFileSystemObjectでフォルダのサイズを直接
 取得する方法で問題ありません。今後問題が出てきたときには再考することにします。

 Dim FSO As Object
 Dim mysize As Long

 Sub test()
  Dim ary() As Variant
  Dim fol As String
  Dim objfol As Object
   Set FSO = CreateObject("Scripting.FileSystemObject")
   fol = "G:\test"
   Set objfol = FSO.getfolder(fol)
   ReDim ary(3, 0)
   ary(0, 0) = objfol.Name
   ary(1, 0) = objfol.datecreated
   ary(2, 0) = objfol.datelastmodified
   mysize = 0
   Call folsizeget(objfol)
   'Call folsizegetB(objfol)
   ary(3, 0) = mysize
   ActiveCell.Resize(4, 1).Value = ary
   Erase ary
   Set objfol = Nothing
   Set FSO = Nothing
 End Sub

 Function folsizeget(ByVal objfol As Object)
  Dim objfile As Object
  Dim objsubfol As Object
   If objfol.Files.Count <> 0 Then
      For Each objfile In objfol.Files
       mysize = mysize + FileLen(objfile.Path)
      Next objfile
   End If
   If objfol.subfolders.Count <> 0 Then
      For Each objsubfol In objfol.subfolders
       Call folsizeget(objsubfol)
      Next objsubfol
   End If
 End Function

 Function folsizegetB(ByVal objfol As Object)
  Dim myfile As Variant
  Dim filepath As Variant
  Dim objsubfol As Object
   If objfol.Files.Count <> 0 Then
      myfile = Dir(objfol.Path & "\*.*")
      Do While myfile <> ""
       filepath = objfol.Path & "\" & myfile
       mysize = mysize + FileLen(filepath)
       myfile = Dir()
      Loop
   End If
   If objfol.subfolders.Count <> 0 Then
      For Each objsubfol In objfol.subfolders
       Call folsizegetB(objsubfol)
      Next objsubfol
   End If
 End Function
（田吾作） 2014/04/28(月) 00:54

コメント返信：

[ 一覧(最新更新順) ]

[[20140426211455]] 『フォルダのサイズを取得する』（田吾作） ページの最後に飛ぶ

[[20140426211455]]　『フォルダのサイズを取得する』（田吾作）　ページの最後に飛ぶ