フォルダサイズの大きい順に並べ替えについて

【環境】Windows10 Enterprise 2016 LTSB 【状況】 Windows10には、フォルダのサイズ...

Proof4 さんからの 回答

  • 2019-02-10 02:05:31
  • 回答No.2
Proof4

ベストアンサー率 67% (84/124)

ご提示いただいたプログラムを参考に、書き換えたVBSプログラムを示します。
どのような基準で並べ替えるのか分からなかったため、全てのフォルダサイズをフラットな状態で比較して並べています。
-----------------------------------------
'変数の宣言を強制
Option Explicit

'変数objFsoを宣言
Dim objFso
'objFsoにScripting.FileSystemObjectのオブジェクトをセット
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")

'変数objSubFolderを宣言
Dim objSubFolder
'objFolderにフォルダをセット
Set objSubFolder = objFso.GetFolder(".\")


'変数writeFileを宣言
Dim writeFile
'書き込み用ファイル
Set writeFile = objFso.OpenTextFile("フォルダサイズ情報.html", 2, True)

'変数countを宣言と初期化
Dim count
'フォルダの深さカウント用
count = 0

Dim ArrayCounter
ArrayCounter = 0
ReDim keys(1)
ReDim lines(1)

'Forループ用変数
Dim i

writeFile.WriteLine "<head><style></style></head>"

'ShowFolderSize()メソッドを実行
Call ShowFolderSize(objSubFolder)

'ShowFolderSize()メソッド
Private Sub ShowFolderSize(ByRef objFolder)

'Long型に変換
Dim ISize
ISize = CLng(objFolder.Size * 0.001) * 0.001

'writeFile.WriteLine FormatNumber(ISize) & "MB" & "\t\t" & objFolder.Path
Dim npath
npath = Replace(objFolder.Path, " ", "_")
Dim splArray
splArray = Split(npath, "\")
Dim classname
classname = ""
For i = 0 to UBound(splArray) - 1
classname = classname & splArray(i)
Next
classname = Replace(classname, ":", "")
keys(ArrayCounter) = ISize
lines(ArrayCounter) = "<li class=""" & classname & """ data-path=""" & Replace(Replace(npath, "\", ""), ":", "") & """>" & FormatNumber(ISize) & "MB" & " : " & npath
ArrayCounter = ArrayCounter + 1

ReDim Preserve keys(ArrayCounter+1)
ReDim Preserve lines(ArrayCounter+1)

'自身のクラスを再起呼び出し
For Each objSubFolder In objSubFolder.subFolders

'フォルダの深さカウント用+1
count = count + 1

Call ShowFolderSize(objSubFolder)

'フォルダの深さカウント用-1
count = count - 1
Next
End Sub

QuickSort keys, lines, 0, UBound(keys)

Sub QuickSort(ByRef strKeys, ByRef strLines, lStart, lEnd)
Dim baseKey
Dim baseKeyTemp
Dim baseLineTemp
Dim i
Dim j

baseKey = strKeys((lStart + lEnd) \ 2) '中央値
i = lStart
j = lEnd
Do
'左から中央値より大きいものを検索
Do While strKeys(i) < baseKey
i = i + 1
Loop
'右から中央値より小さいものを検索
Do While strKeys(j) > baseKey
j = j - 1
Loop
If i >= j Then
Exit Do
End If
'データの交換
baseKeyTemp = strKeys(i)
strKeys(i) = strKeys(j)
strKeys(j) = baseKeyTemp
baseLineTemp = strLines(i)
strLines(i) = strLines(j)
strLines(j) = baseLineTemp
i = i + 1
j = j - 1
Loop
'左半分の処理
If lStart < i - 1 Then
QuickSort strKeys, strLines, lStart, i - 1
End If
'右半分の処理
If lEnd > j + 1 Then
QuickSort strKeys, strLines, j + 1, lEnd
End If
End Sub

For i = 0 to ArrayCounter
writeFile.WriteLine lines(ArrayCounter - i)
Next

writeFile.WriteLine "<script>"
writeFile.WriteLine "var li=document.getElementsByTagName('li'),style=document.getElementsByTagName('style')[0];for(item of li)item.addEventListener('click',function(){var e=this.getAttribute('data-path');style.innerHTML='li:not(.'+e+'){display: none;}'});"
writeFile.WriteLine "</script>"
msgbox("出力完了")
-----------------------------------------
出力は簡易的なHTML形式です。ブラウザで閲覧することを想定しており、各項目をクリックすることでフォルダの階層を進めるようになっています(戻ることはできません)。
KB単位の場合オーバーフローの恐れがあるため、MBでの表示に変更してあります。
プログラム中で用いているクイックソートのサブルーチンは下記URLのものを使用しています。
http://atomicsoft.blog.fc2.com/blog-entry-36.html
補足コメント
Engineer480907

お礼率 72% (566/777)

ありがとうございます。

お礼コメントの内容がNo.1の回答者へのものでした。申し訳ございません。

Cドライブにあるフォルダ内でご教示いただきましたプログラムを実行することができ、フォルダサイズが大きい順でソートされました。

Cドライブ、Dドライブ直下で実行した場合、ファイルに書き込みエラーになるため、確認してみることにします。
投稿日時 - 2019-02-10 14:43:32
お礼コメント
Engineer480907

お礼率 72% (566/777)

ありがとうございます。

以下のプログラムに「フォルダサイズ情報.txt」があることを見落としていました。ファイルには書き出されず、画面には表示されるので、画面表示だけと思っていました。

Cドライブ直下で行うと「行:21 文字:1 エラー:書き込みできません。コード:800A0046」になりましたので、何か要因がありそうなので確認してみることにします。
「Set writeFile = objFso.OpenTextFile("フォルダサイズ情報.txt", 2, True)」の箇所が要因のようです。


'変数の宣言を強制
Option Explicit

'変数objFsoを宣言
Dim objFso

'objFsoにScripting.FileSystemObjectのオブジェクトをセット
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")

'変数objSubFolderを宣言
Dim objSubFolder

'objFolderにフォルダをセット
Set objSubFolder = objFso.GetFolder(".\")


'変数writeFileを宣言
Dim writeFile

'書き込み用ファイル
Set writeFile = objFso.OpenTextFile("フォルダサイズ情報.txt", 2, True)

'変数countを宣言と初期化
Dim count
'フォルダの深さカウント用
count = 0

'ShowFolderSize()メソッドを実行
Call ShowFolderSize(objSubFolder)



'ShowFolderSize()メソッド
Private Sub ShowFolderSize(ByRef objFolder)

'" -"をフォルダの深さ分だけ出力する
Dim n
n = 0
Do While n < count
writeFile.Write " -"
n = n + 1
Loop

'整数型に変換
Dim ISize
ISize = CLng(objFolder.Size) * 0.001
writeFile.WriteLine objFolder.Name & ": " & FormatNumber(ISize) & "K"

'自身のクラスを再起呼び出し
For Each objSubFolder In objSubFolder.subFolders

'フォルダの深さカウント用+1
count = count + 1

Call ShowFolderSize(objSubFolder)

'フォルダの深さカウント用-1
count = count - 1

Next

End Sub
投稿日時 - 2019-02-10 14:32:37
この回答にこう思った!同じようなことあった!感想や体験を書こう!
この回答にはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。
関連するQ&A
ページ先頭へ