Custom function file size NTFS compressed

[Will from London]

Hi

I have a custom function that displays the size (in KB, MB, GB etc) of folders. I use it to record the size of folders on servers. Some folders are compressed on NTFS servers so what would be really useful is if I could show the "size on disk" property referred to in the properties box in windows explorer when one right-clicks on a folder or file.

My existing code is:

Function DirSize(dirName As String, Scaler As String) As Variant

Dim fileSys As Object
Dim folderName As Object

If Right(dirName, 1) <> "\" Then dirName = dirName & "\"

If dirName = "\" Then
    DirSize = "# - Folder not recognised"
ElseIf Dir(dirName) = "" Then
    DirSize = "# - Folder not found"
Else
    Set fileSys = CreateObject("Scripting.FileSystemObject")
    Set folderName = fileSys.GetFolder(dirName)
    Select Case UCase(Scaler)
        Case "B"
            DirSize = folderName.Size / (1024 ^ 0)
        Case "K"
            DirSize = folderName.Size / (1024 ^ 1)
        Case "M"
            DirSize = folderName.Size / (1024 ^ 2)
        Case "G"
            DirSize = folderName.Size / (1024 ^ 3)
        Case "T"
            DirSize = folderName.Size / (1024 ^ 4)
        Case Else
            DirSize = "# - Scaler not recognised"
    End Select
    Set fileSys = Nothing
    Set folderName = Nothing
End If

End Function

Any help much appreciated. Regards

Will

 

[Richard Schollar]

Hi Will


EDIT: Sorry Will, on second reading realised you were after the folder size, not the file size. My apologies...

You can do this using the Windows API (I would be slightly surprised if this isn't available thru the FileSystemObject though - I don't know it well, so cannot state for sure that you can't do this) eg:

Private Const OPEN_EXISTING = 3

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetCompressedFileSize Lib "kernel32" Alias "GetCompressedFileSizeA" (ByVal lpFileName As String, lpFileSizeHigh As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long


Sub test()
Dim lngHandle As Long, myFile As String, msg As String
myFile = "C:\MyFile.xls" ' amend as appropriate

lngHandle = CreateFile(myFile, 0, 0, ByVal 0&, OPEN_EXISTING, 0, 0)  'get a handle to the file

msg = "File size is: " & Chr$(9) & GetFileSize(lngHandle, ByVal 0&) & " bytes" & vbNewLine & "Size on disk is: " & _
            Chr$(9) & GetCompressedFileSize(myFile, ByVal 0&) & " bytes"
MsgBox msg
End Sub

Copy to a blank module (declarations need to be at the top) and amend the file path as required.

Hope it helps!

Richard

 

[Will from London]

Hi Richard

Thanks for the response. Unfortunately it is the folder size that I'm interested in. I obviously didn't help matters by putting the word "file" in the title!

If someone could let me know how to do similar with an entire folder that would be great. (I'll try to figure it out myself from your code as a starting point but any help would be much appreciated).

Regards

Will

 

[Will from London]

Hi

Having used the starting point that Richard gave and searching the internet the only option open to me seems to be to set up a loop to go through all files within a folder (and all subfolders within each folder) and add up all the compressed file sizes using the API coding shown above.

This I've done and it seems to work:

Option Explicit

Public compressedSize As Double, f(100), SubFolders(100), fileSys, folder(100), lEvels
Private Const OPEN_EXISTING = 3

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetCompressedFileSize Lib "kernel32" Alias "GetCompressedFileSizeA" (ByVal lpFileName As String, lpFileSizeHigh As Long) As Long


Function DirSize(dirName As String, actualCompressed As String, Scaler As String) As Variant

Dim folderName As Object
Dim fileNameStr As String

'actualCompressed should be "Actual" or "Compressed", "A" or "C"

If Right(dirName, 1) <> "\" Then dirName = dirName & "\"
If dirName = "\" Then
    DirSize = "# - Folder not recognised"
ElseIf Dir(dirName) = "" Then
    DirSize = "# - Folder not recognised"
Else
    Set fileSys = CreateObject("Scripting.FileSystemObject")
    If UCase(Left(actualCompressed, 1)) = "A" Then
        Set folderName = fileSys.GetFolder(dirName)
        Select Case UCase(Left(Scaler, 1))
            Case "B"
                DirSize = folderName.Size / (1024 ^ 0)
            Case "K"
                DirSize = folderName.Size / (1024 ^ 1)
            Case "M"
                DirSize = folderName.Size / (1024 ^ 2)
            Case "G"
                DirSize = folderName.Size / (1024 ^ 3)
            Case "T"
                DirSize = folderName.Size / (1024 ^ 4)
            Case Else
                DirSize = "# - Scaler not recognised"
        End Select
    Else
        compressedSize = 0
        'Add up all files in main directory:
        'GoTo skipPoint
        fileNameStr = Dir(dirName)
        Do While fileNameStr <> ""
            compressedSize = compressedSize + GetCompressedFileSize(dirName & fileNameStr, ByVal 0&)
            fileNameStr = Dir()
        Loop

        'To include subfolders:
        lEvels = 100
        Call loopThroughSubfolders(dirName, 0)

        'Then do the preFix stuff
        Select Case UCase(Left(Scaler, 1))
            Case "B"
                DirSize = compressedSize / (1024 ^ 0)
            Case "K"
                DirSize = compressedSize / (1024 ^ 1)
            Case "M"
                DirSize = compressedSize / (1024 ^ 2)
            Case "G"
                DirSize = compressedSize / (1024 ^ 3)
            Case "T"
                DirSize = compressedSize / (1024 ^ 4)
            Case Else
                DirSize = "# - Scaler not recognised"
        End Select
    End If
End If


End Function


Sub loopThroughSubfolders(Path As Variant, level As Integer)
    Set f(level) = fileSys.GetFolder(Path)
    Set SubFolders(level) = f(level).SubFolders
    Dim fileNameStr As String
    
    For Each folder(level) In SubFolders(level)
        fileNameStr = Dir(Path & folder(level).Name & "\")
        Do While fileNameStr <> ""
            compressedSize = compressedSize + GetCompressedFileSize(Path & folder(level).Name & "\" & fileNameStr, ByVal 0&)
            fileNameStr = Dir()
        Loop
        If level < lEvels Then
            Call loopThroughSubfolders(Path & folder(level).Name & "\", level + 1)
        End If
    Next
    
End Sub

Regards

Will