FC2ブログ

スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

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より解像度が上がらずぼやけた感じで残念です。
FC2カウンター
阿良々木''@_掲示板 NEW
入口
RSSリンクの表示
プロフィール

arakurikaesiki

Author:arakurikaesiki
阿良々木(あらくりかえしき)と申します。趣味はらくがき/ビオトープ/アクアリウム、好きな小説は物語シリーズです。あと、仕事で楽したいためにExcelのVBAをちょくちょくいじってます。
なお、当ブログはリンクフリーです、よろしければリンク貼ってください。
また、ブロともさまも募集中です。コメントとかもらえるとすごく喜びます。

ブロとも様募集中ですm(_)m

この人とブロともになる

最新コメント
リンク
らくがき
新着記事
トップページ Jan 01, 2030
PLUS COFFEE Oct 10, 2018
アキネトン追加 Sep 27, 2018
操作性.… Sep 23, 2018
まわりに危機感がないと… Sep 19, 2018
異世界魔王と召喚少女の奴隷魔術 四月は君の嘘 Sep 18, 2018
その一言で Sep 13, 2018
住所と名前を書いてハンコを押す Sep 12, 2018
残高が… Sep 12, 2018
リクは基本無しでお願いします(笑) Sep 10, 2018
カテゴリ
カレンダー
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 - - -
アクセスランキング
[ジャンルランキング]
ブログ
6727位
アクセスランキングを見る>>

[サブジャンルランキング]
イラストブログ
401位
アクセスランキングを見る>>
にほんブログ村(ビオトープ)
月別アーカイブ
人気ブログランキング
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。