Custom function file size NTFS compressed

Will from London

Board Regular
Joined
Oct 14, 2004
Messages
217
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:
Code:
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
 

Some videos you may like

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

Richard Schollar

MrExcel MVP
Joined
Apr 19, 2005
Messages
23,707
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:

Code:
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

Board Regular
Joined
Oct 14, 2004
Messages
217
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

Board Regular
Joined
Oct 14, 2004
Messages
217
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:
Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,128,063
Messages
5,628,379
Members
416,314
Latest member
Dan99321

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top