Sub FolderSizeCK()サブフォルダの容量をはかります(*ノ∪`*)

昨日(今朝)20日の記事でふれた、サブフォルダのサイズを調べるマクロです。
メディアにバックアップを取る際、このフォルダとこのフォルダは1枚で焼けるなとか、このフォルダは分割しないと1枚に焼けないなとか、実際に職場でも使っていて結構重宝しています。職場の電算関係の部署が似たようなツールをライブラリに登録していたんですけどバイト単位の表示しかせす、使いづらかったので色んなサイトを参考にして自分で作りました。
お役に立てれば幸いです(*ノ∪`*)


動作確認:OS:Windows7、Windows10/エクセル:2010

Sub FolderSizeCK()
  Dim FolderPath As String
  Dim FSO As Object, f As Variant, cnt As Long
  Set FSO = CreateObject("Scripting.FileSystemObject")
  ChDir ThisWorkbook.Path’Win7ではできたのにWin10ではだめ、なんで?
  Cells.Select
   With Selection
   .Clear
   .ColumnWidth = 8.1
  End With
  Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   With fd
   .Title = "フォルダを選択してください"
    If .Show = True Then
    FolderPath = .SelectedItems(1)
   End If
   End With
   Set fd = Nothing
   'キャンセル時の処理
   If FolderPath = "" Then
   Exit Sub
   End If
   If FolderPath = "ライブラリ" Then ’Win7用?Win10にはない?
   MsgBox "「ライブラリ」は特殊なフォルダなので選択できません"
   Exit Sub
   End If
 For Each f In FSO.GetFolder(FolderPath).SubFolders
  cnt = cnt + 1
  Columns("A:A").Select
  Selection.NumberFormatLocal = "@" '「0911」が「911」等になるのを防ぐ(さっき追加)
  Cells(cnt, 1) = FSO.GetFolder(f).Name
  Cells(cnt, 2) = FSO.GetFolder(f).Size 'バイト
  Cells(cnt, 3) = FSO.GetFolder(f).Size / 1024 'KB
  Cells(cnt, 4) = FSO.GetFolder(f).Size / 1024 / 1024 'MB
  Cells(cnt, 5) = FSO.GetFolder(f).Size / 1024 / 1024 / 1024 'GB
  Cells(cnt, 6) = FSO.GetFolder(f).DateLastModified
  Next f
 Set FSO = Nothing
 Rows("1:1").Select 'ヘッダーを作成
      Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 Range("A1") = "サブフォルダ名"
 Range("B1") = "バイト"
 Range("C1") = "KB"
 Range("D1") = "MB"
 Range("E1") = "GB"
 Range("F1") = "最終更新日"
  With Selection
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter
  End With
 Range("A1").Select
 Selection.CurrentRegion.Select
 With Selection.Borders
 .LineStyle = True
 End With
 Range("C:E").Select
 Selection.NumberFormatLocal = "0.00" '小数点以下2桁固定
 Range("F:F").Select
 Selection.NumberFormatLocal = "gee.mm.dd(aaa)" '和暦で表示、曜日つき
 Columns("A:F").EntireColumn.AutoFit '列幅のオートフィット
 Range("A1:F1").Select
  With Selection.Interior
  .ColorIndex = 37
  End With
  '並び替え(名前順) Win7では並んだのにWin10では並ばなかったので追記
    Range("A1").Select
    Selection.CurrentRegion.Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Selection.CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
     Range("A1").Select ’ついでにフィルターもセット
   Selection.CurrentRegion.Select
   Selection.AutoFilter
   Range("E2").Select
 End Sub

職場がWin7で家がWin10なので動作が少し違いました。
並べ替えがしやすいようフィルターも追加しました。
エクスプローラーと比べると小数点以下の端数があいませんが、メディアに焼くときにフォルダの大まかなサイズを調べるために作ったので勘弁してください。結構役に立つツールです。延滞金のユーザー定義関数より需要があるんじゃないかと思います。
スポンサーサイト

8日の記事に追記していたら、日付変わった(;_;)

7,8,9日と3日連続で記事をアップしたので、10日も更新しようとしてたんですけど、8日の記事に追記してたら日付変わってました(´・_・`)
もしよければ、10日に更新した8日の記事の続きを見てもらえれば幸いです。

SONYのMDR-DS7100買いました(#^.^#)

テレビを先月買い換えて4K(UHD)画質を楽しんでいたのですが、どうせなら良い音で聞きたいと思い、SONYのMDR-DS7100買ってみました。7.1chデジタルサラウンド、2.4GHz デジタル無線方式です。
s-MDR-DS7100.jpg
これまでは、同じくSONYの5.1chデジタルサラウンドワイヤレスヘッドホン(型番忘れました)を使っていたのですが経年劣化して5.1chどころか右か左か片方からしか音がです以前から買い換えたいと思っていたので丁度良かったです。
それで、使ってみた感想からいうと経年劣化する前の古いヘッドホンの方が音が良かった感があり微妙な気分です。
それと、WOWOWも契約しているのですが5.1chの番組は放送してますが、7.1chの番組は見かけません。
また自分が持っているBDに7.1chのものはありません。なので、7.1ch対応のコンテンツを試した時でないと比較するのは時期尚早ですね。
 話しは変わりますが今日は歯医者に行って親知らずを抜いて来ました。痛かったです。で、麻酔が効いてるうちはよかったのですが先程から麻酔がキレてジンジンと痛みます。何か意識を痛みからそらさないと堪りません。そんなわけで今記事を書いてます。それでも痛いですギャ─Σ(゜Д゜)Σ(゜Д゜)Σ(゜Д゜)ノノ─ァァァッ!!!
痛みから逃れるため睡眠薬のんでもう寝ます。それでは失礼します。

REGZA-40M500Xが家に来て1ヶ月…

REGZA-32ZP2からREGZA-40M500Xに買い換えて1月が過ぎました、画質はテレビ側での4Kアプコンがおもったよりも優秀で、フルHDで収録されたコンテンツであればかなり綺麗に視聴できるので十分満足です。
ただ、2画面や3Dが無くなったり、パワーダウンしたところもあります。まあ、2画面や3Dは不要な機能と思っていたのでいいのですが、ノートPCとテレビをHDMI接続したときに、ZP2はフルHDのモニターとして使えたのですが、M500Xは1366×768より解像度が上がらずぼやけた感じで残念です。
訪問者数
プロフィール

arakurikaesiki

Author:arakurikaesiki
阿良々木(あらくりかえしき)と申します。趣味はビオトープとアクアリウム、好きな小説は物語シリーズです。あと、仕事で楽したい(良く言えば効率化)ためにExcelやAccessでVBAをちょくちょくいじってます。
 当ブログはリンク大歓迎です。ブロともも絶賛募集中!

最新記事
カテゴリ
カレンダー
10 | 2016/11 | 12
- - 1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30 - - -
アクセスランキング
[ジャンルランキング]
アニメ・コミック
1278位
アクセスランキングを見る>>

[サブジャンルランキング]
アニメ
580位
アクセスランキングを見る>>
最新コメント
ミナミヌマエビ
にほんブログ村(ビオトープ)
にほんブログ村
月別アーカイブ
リンク(リンクフリー、大歓迎です)
RSSリンクの表示
ブロとも絶賛募集中

この人とブロともになる