Re: Hard Drive Folder Size

"Valleyboy" <Valleyboy@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message news:C7AD6B7A-89E7-4A1B-B361-94667A58A896@xxxxxxxxxxxxxxxx

Using a piece of code or function in Access 2003, I'd like
to get the total size of a folder (including sub folders) on a
hard drive. The drive and folder will always be the same.

Here's some code that will do it for you. As it stands it displays a dialog which allows you (or rather the user) to select the desired folder, but you can of course simply comment out that part and instead hard code a specific folder. I've placed some comments in the code to show you how to do that. It also properly takes into account files larger than the 2GB VB signed Long limit and also the 4GB unsigned Long limit. It returns the number of folders and files and the total file size and also the total size taken on disk. Paste the code into a VBA Form containing a Command Button.

Mike

Option Explicit
Private Declare Function GetDiskFreeSpace _
Lib "kernel32" Alias "GetDiskFreeSpaceA" _
(ByVal lpRootPathName As String, _
lpSectorsPerCluster As Long, _
lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, _
lpTotalNumberOfClusters As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (ByRef Destination As Any, _
Source As Any, ByVal Length As Long)
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
(bBrowse As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
(ByVal lItem As Long, ByVal sDir As String) As Long
Private Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" (ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" _
Alias "FindNextFileA" (ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Const MAX_PATH = 260
Private Type WIN32_FIND_DATA
lngFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
lngFileSizeHigh As Long
lngFileSizeLow As Long
lngReserved0 As Long
lngReserved1 As Long
fileName As String * MAX_PATH
strAlternate As String * 14
End Type
Private Type BrowseInfo
hWndOwner As Long
pidlRoot As Long
sDisplayName As String
sTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private directories As Long
Private folders As Long
Private files As Long
Private totalSize As Currency
Private totalSizeOnDisk As Currency
Private loMask As Long
Private hiMask As Long
Private clusterSize As Currency

Public Sub GetClusterSize(disk As String)
Dim s1 As String, sectorsPerCluster As Long, bytesPerSector As Long
Dim free As Long, total As Long, retVal As Long, bytesperCluster As Long
retVal = GetDiskFreeSpace _
(disk, sectorsPerCluster, bytesPerSector, free, total)
bytesperCluster = sectorsPerCluster * bytesPerSector
loMask = bytesperCluster - 1
hiMask = &HFFFFFFFF - loMask
clusterSize = CCur(bytesperCluster / 10000&)
End Sub

Private Function Browse_Folder() As String
' Let the user browse for a folder. Return the
' selected folder. Return an empty string if
' the user cancels.
Dim bInf As BrowseInfo
Dim lItem As Long
Dim sDirName As String
Dim hwnd As Long
bInf.sDisplayName = Space$(MAX_PATH)
bInf.sTitle = "Select Folder"
bInf.ulFlags = BIF_RETURNONLYFSDIRS
lItem = SHBrowseForFolder(bInf)
If lItem Then
sDirName = Space$(MAX_PATH)
If SHGetPathFromIDList(lItem, sDirName) Then
Browse_Folder = Left(sDirName, InStr(sDirName, Chr$(0)) - 1)
Else
Browse_Folder = ""
End If
End If
End Function

Private Sub countFiles(folderPath As String, recurse As Boolean)
Dim fd As WIN32_FIND_DATA
Dim hFind As Long
Dim strFile As String
Dim strSearch As String
Dim fileSize As Currency
Dim SizeOnDisk As Currency
Dim roundUp As Boolean
If Right$(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
strSearch = folderPath & "*.*"
hFind = FindFirstFile(strSearch, fd)
If hFind > 0 Then
Do
If (fd.lngFileAttributes And FILE_ATTRIBUTE_DIRECTORY) _
= FILE_ATTRIBUTE_DIRECTORY Then
' check for "." or ".." (quicker to do it this way
' than by checking for both substrings or by
' stripping the whole string to the trailing zero
' and then checking the actual string) Note that
' a valid real dir name cannot begin with "."
If Left$(fd.fileName, 1) = "." Then
' ignore these
Else
' It is a directory so do what you want to do with
' directories.
folders = folders + 1
If recurse Then
countFiles folderPath & Left$(fd.fileName, _
InStr(fd.fileName, Chr(0)) - 1), recurse
End If
End If
Else
' It is a file (not a directory) so do what you want
' to do with files. In this example we want to:
' Add its size to a running total:
' Note: the following line is only required if
' you want to extract the returned file name
' from the file name in fd.filename (which is
' terminated with a zero byte). For this specific
' task we do not need to do that, and leaving it
' out speeds up the code a bit.
'strFile = Left$(fd.fileName, InStr(fd.fileName, Chr(0)) - 1)
'
files = files + 1
If (fd.lngFileSizeLow And loMask) <> 0 Then
roundUp = True
Else
roundUp = False
End If
CopyMemory fileSize, fd.ftLastWriteTime.dwHighDateTime, 8
CopyMemory fileSize, fd.lngFileSizeLow, 4
totalSize = totalSize + fileSize
If roundUp Then
fd.lngFileSizeLow = fd.lngFileSizeLow And hiMask
End If
CopyMemory SizeOnDisk, fd.ftLastWriteTime.dwHighDateTime, 8
CopyMemory SizeOnDisk, fd.lngFileSizeLow, 4
If roundUp Then '
totalSizeOnDisk = totalSizeOnDisk + SizeOnDisk + clusterSize
Else
totalSizeOnDisk = totalSizeOnDisk + SizeOnDisk
End If
End If
Loop While CBool(FindNextFile(hFind, fd))
Call FindClose(hFind)
End If
End Sub

Private Sub CommandButton1_Click()
Dim sfolder As String
Dim t1 As Single, t2 As Single
Dim Sectors As Long, Bytes As Long
Dim FreeC As Long, TotalC As Long
Dim total As Long, Freeb As Long
CommandButton1.Enabled = False
sfolder = Browse_Folder
If sfolder = "" Then ' Cancel
Caption = "No Folder Selected"
Else
GetClusterSize Left$(sfolder, InStr(sfolder, "\"))
directories = 0
folders = 0
files = 0
totalSize = 0
totalSizeOnDisk = 0
'Caption = "Please wait . . ."
'call the countFiles routine (True = recursive)
t1 = Timer
countFiles sfolder, True
t2 = Timer
Dim s1 As String
s1 = Format(files, "###,###,##0") & " files, "
s1 = s1 & Format(folders, "###,###,##0") & " folders."
s1 = s1 & vbCrLf & _
"Total file size = " & _
Format((totalSize * 10000&), "###,###,###,##0")
s1 = s1 & vbCrLf & _
"Total size on disk = " & _
Format((totalSizeOnDisk * 10000&), "###,###,###,##0")
s1 = s1 & vbCrLf & _
"Time taken = " & Format(t2 - t1, "###.00") & " seconds."
MsgBox s1
End If
DoEvents ' get rid of any queued button clicks
CommandButton1.Enabled = True
End Sub


.