checking dir # of files and SIZE of dir how?

[IQAB]

I want to be able to check the numbers of files in a directory and the directories/folders total size.

I have a code that will check file size
but if i change the file into c:\folder\*.* I.E i get an error , and i tryed it without the *.* , same thing,

any ideas will be apreciated

[Hack]

Try this. Change the folder name as appropriate.

Option Explicit
 
Private Const MAX_PATH = 260
 
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
 
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 Function EndSlash(ByVal PathIn As String) As String
If Right$(PathIn, 1) = "\" Then
    EndSlash = PathIn
Else
    EndSlash = PathIn & "\"
End If
End Function
 
Private Function SizeOf(ByVal DirPath As String) As Double
Dim hFind As Long
Dim fdata As WIN32_FIND_DATA
Dim dblSize As Double
Dim sName As String
Dim x As Long
On Error Resume Next
x = GetAttr(DirPath)
If Err Then SizeOf = 0: Exit Function
 
If (x And vbDirectory) = vbDirectory Then
    dblSize = 0
    Err.Clear
    sName = Dir$(EndSlash(DirPath) & "*.*", vbSystem Or vbHidden Or vbDirectory)
        If Err.Number = 0 Then
           hFind = FindFirstFile(EndSlash(DirPath) & "*.*", fdata)
               If hFind = 0 Then Exit Function
                Do
                  If (fdata.dwFileAttributes And vbDirectory) = vbDirectory Then
                    sName = Left$(fdata.cFileName, InStr(fdata.cFileName, vbNullChar) - 1)
                       If sName <> "." And sName <> ".." Then
                        dblSize = dblSize + SizeOf(EndSlash(DirPath) & sName)
                       End If
                  Else
                    dblSize = dblSize + fdata.nFileSizeHigh * 65536 + fdata.nFileSizeLow
                  End If
                DoEvents
                Loop While FindNextFile(hFind, fdata) <> 0
                hFind = FindClose(hFind)
        End If
Else
    dblSize = FileLen(DirPath)
End If
SizeOf = dblSize
End Function
 
Private Sub Command1_Click()
Screen.MousePointer = vbHourglass
Dim dblFolderSize As Double
dblFolderSize = SizeOf("d:\documents and settings")
MsgBox Format(dblFolderSize, "#,##0;(#,##0)")
Screen.MousePointer = vbDefault
End Sub

[Code Doc]

Consider this:

Dim FileName As String, Bytes As Long, FileCount As Integer
Private Sub Form_Load()
FileName = Dir("*.*")
While Len(FileName)
    FileCount = FileCount + 1
    Bytes = Bytes + FileLen(FileName)
    FileName = Dir()
Wend
MsgBox Str(FileCount) & " files on subdirectory using" & Str(Bytes) & " bytes."
End Sub

This seems to work well for the immediate subdirectory and that may be all that you need. Change the path to get another one.

[IQAB]

the first one doeent wokr , it has errors

the second one cant be set to do other directions except the one that the EXE is in..

like if i chaneg the "*.*" into "c:\*.*" wont work , said file not found .

[Paul M]

So you want to get the number of files in the root folder and all the sub folders? As well as the total file size? Please clarify.

[RhinoBull]

You can also use FileSystemObject - not the fastest method but definitely the simplest:

Private Sub Command1_Click()
'============================
Dim fso As Object
Dim drv As Object

    Screen.MousePointer = vbHourglass
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set drv = fso.GetDrive(fso.GetDriveName("c:"))
    
    Debug.Print "Drive's total size: " & FormatNumber(drv.TotalSize / 1024, 0) & " KB"
    Debug.Print "Drive's available space: " & FormatNumber(drv.AvailableSpace / 1024, 0) & " KB"
    Debug.Print "Drive's free space: " & FormatNumber(drv.FreeSpace / 1024, 0) & " KB"
    Debug.Print "Total subfolders: " & drv.RootFolder.SubFolders.Count
    
    Screen.MousePointer = vbDefault

End Sub

[c_owl]

i can you please post hoe to change bytes to Mb and gig

[RhinoBull]

Are you saying you don't know how to delete given number by 1024?

[DigiRev]

i can you please post hoe to change bytes to Mb and gig

Here is some code given to me by Ellis Dee from these forums. It accepts the file size as currency to handle large sizes (> 2GB, I think up to around 920 Terabytes).

You may or may not need to use the CCur() function to convert the long value to currency when using it, ie:

Dim lonTotalSize As Long
 
lonTotalSize = SizeOfDirectory
lblSize.Caption = FormatSize(CCur(lonTotalSize))

Here is the code:

Public Function FormatSize(ByVal Size As Currency) As String
    Const Kilobyte As Currency = 1024@
    Const HundredK As Currency = 102400@
    Const ThousandK As Currency = 1024000@
    Const Megabyte As Currency = 1048576@
    Const HundredMeg As Currency = 104857600@
    Const ThousandMeg As Currency = 1048576000@
    Const Gigabyte As Currency = 1073741824@
    Const Terabyte As Currency = 1099511627776@
    
    If Size < Kilobyte Then
        FormatSize = Int(Size) & " bytes"
    ElseIf Size < HundredK Then
        FormatSize = Format(Size / Kilobyte, "#.0") & " KB"
    ElseIf Size < ThousandK Then
        FormatSize = Int(Size / Kilobyte) & " KB"
    ElseIf Size < HundredMeg Then
        FormatSize = Format(Size / Megabyte, "#.0") & " MB"
    ElseIf Size < ThousandMeg Then
        FormatSize = Int(Size / Megabyte) & " MB"
    ElseIf Size < Terabyte Then
        FormatSize = Format(Size / Gigabyte, "#.00") & " GB"
    Else
        FormatSize = Format(Size / Terabyte, "#.00") & " TB"
    End If
End Function

[Lord Orwell]

If you use rhinobull's code, you will need to add a reference to the filesystem object.

[RhinoBull]

Well, if you look at my sample code you will find that it's using late bindings so no references are needed at all.
However scripting library is required but since it's a major component since Win98 we are safe.

[c_owl]

Here is some code given to me by Ellis Dee from these forums. It accepts the file size as currency to handle large sizes (> 2GB, I think up to around 920 Terabytes).

You may or may not need to use the CCur() function to convert the long value to currency when using it, ie:

Dim lonTotalSize As Long
 
lonTotalSize = SizeOfDirectory
lblSize.Caption = FormatSize(CCur(lonTotalSize))

Here is the code:

Public Function FormatSize(ByVal Size As Currency) As String
    Const Kilobyte As Currency = 1024@
    Const HundredK As Currency = 102400@
    Const ThousandK As Currency = 1024000@
    Const Megabyte As Currency = 1048576@
    Const HundredMeg As Currency = 104857600@
    Const ThousandMeg As Currency = 1048576000@
    Const Gigabyte As Currency = 1073741824@
    Const Terabyte As Currency = 1099511627776@
    
    If Size < Kilobyte Then
        FormatSize = Int(Size) & " bytes"
    ElseIf Size < HundredK Then
        FormatSize = Format(Size / Kilobyte, "#.0") & " KB"
    ElseIf Size < ThousandK Then
        FormatSize = Int(Size / Kilobyte) & " KB"
    ElseIf Size < HundredMeg Then
        FormatSize = Format(Size / Megabyte, "#.0") & " MB"
    ElseIf Size < ThousandMeg Then
        FormatSize = Int(Size / Megabyte) & " MB"
    ElseIf Size < Terabyte Then
        FormatSize = Format(Size / Gigabyte, "#.00") & " GB"
    Else
        FormatSize = Format(Size / Terabyte, "#.00") & " TB"
    End If
End Function

im using the above code to try and format drive and file bytes, but i get error
MUST SPECIFY INDEX FOR OBJECT ARRAY
im usung the code below.. please help ive been at it 2 days and loosing my mind

Set fso = CreateObject("Scripting.FileSystemObject")
    Set drv = fso.GetDrive(fso.GetDriveName((Mid(drive.Caption, 1, 2))))
   Debug.Print "-------------------------------"
   Debug.Print FormatSize(CCur(drv.AvailableSpace))' this returns error
     Debug.Print "______________"
    StatusBar1.Panels(1) = "Drive's total: " & FormatNumber(drv.TotalSize / 1024, 0) & " KB"
     StatusBar1.Panels(2) = "Drive space: " & FormatNumber(drv.AvailableSpace / 1024, 0) & " KB"

[Ellis Dee]

im using the above code to try and format drive and file bytes, but i get error
MUST SPECIFY INDEX FOR OBJECT ARRAY
im usung the code below.. please help ive been at it 2 days and loosing my mind

Set fso = CreateObject("Scripting.FileSystemObject")
    Set drv = fso.GetDrive(fso.GetDriveName((Mid(drive.Caption, 1, 2))))
   Debug.Print "-------------------------------"
   Debug.Print FormatSize(CCur(drv.AvailableSpace))' this returns error
     Debug.Print "______________"
    StatusBar1.Panels(1) = "Drive's total: " & FormatNumber(drv.TotalSize / 1024, 0) & " KB"
     StatusBar1.Panels(2) = "Drive space: " & FormatNumber(drv.AvailableSpace / 1024, 0) & " KB"

Hmmm. The FormatSize() function doesn't use any objects or arrays, so I'm thinking it has something to do with the fso stuff. (I never use fso, so I'm just guessing.)

Try this code and post what happens:

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set drv = fso.GetDrive(fso.GetDriveName((Mid(drive.Caption, 1, 2))))
    Debug.Print "-------------------------------"

    Dim curDebug As Currency
    curDebug = CCur(drv.AvailableSpace)

    Debug.Print FormatSize(curDebug)
    Debug.Print "______________"

[Lord Orwell]

is this the late binding?
Set fso = CreateObject("Scripting.FileSystemObject")

[RhinoBull]

Yes, it is.

[c_owl]

Hmmm. The FormatSize() function doesn't use any objects or arrays, so I'm thinking it has something to do with the fso stuff. (I never use fso, so I'm just guessing.)

Try this code and post what happens:

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set drv = fso.GetDrive(fso.GetDriveName((Mid(drive.Caption, 1, 2))))
    Debug.Print "-------------------------------"

    Dim curDebug As Currency
    curDebug = CCur(drv.AvailableSpace)

    Debug.Print FormatSize(curDebug)
    Debug.Print "______________"

hi
i have tryed what u poster but still came back with error array
the error is in
FormatSize = Format(Size / Gigabyte, "#.00") & " GB"

[Ellis Dee]

Are you using Option Explicit? If so, what is drive defined as?

Here's something to get you pointed in the right direction: Create a blank project, copy the following code into the form's code window, and then run:

Option Explicit

Private Sub Form_Load()
    Dim fso As Object
    Dim drv As Object
    Dim curDebug As Currency
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set drv = fso.GetDrive("c:")
    
    curDebug = CCur(drv.AvailableSpace)
    
    MsgBox FormatSize(curDebug)
    Set drv = Nothing
    Set fso = Nothing
End Sub

Public Function FormatSize(ByVal Size As Currency) As String
    Const Kilobyte As Currency = 1024@
    Const HundredK As Currency = 102400@
    Const ThousandK As Currency = 1024000@
    Const Megabyte As Currency = 1048576@
    Const HundredMeg As Currency = 104857600@
    Const ThousandMeg As Currency = 1048576000@
    Const Gigabyte As Currency = 1073741824@
    Const Terabyte As Currency = 1099511627776@
    
    If Size < Kilobyte Then
        FormatSize = Int(Size) & " bytes"
    ElseIf Size < HundredK Then
        FormatSize = Format(Size / Kilobyte, "#.0") & " KB"
    ElseIf Size < ThousandK Then
        FormatSize = Int(Size / Kilobyte) & " KB"
    ElseIf Size < HundredMeg Then
        FormatSize = Format(Size / Megabyte, "#.0") & " MB"
    ElseIf Size < ThousandMeg Then
        FormatSize = Int(Size / Megabyte) & " MB"
    ElseIf Size < Terabyte Then
        FormatSize = Format(Size / Gigabyte, "#.00") & " GB"
    Else
        FormatSize = Format(Size / Terabyte, "#.00") & " TB"
    End If
End Function

[c_owl]

hi
this is fantastice thanks for the help.
its run great on it own but when i input it to my program is returns a error
run-time error !344!
must specify index for object array
i ran it in its own mobula because thats how i ran it on its own

[Ellis Dee]

I don't know what more I can do to help without seeing the project. Can you zip it up and attach it? (Please don't use rar; I can't read rar archives.)

[c_owl]

my program has a lot to g yet I'm going to post it when I have done it, because of all the help I have had from everyone.
I have got around it by doing something else,

my program is a database witch saves a your videos on mediacentre and all covers. it also allows you to manage hardrive space, that's what I'm working on now.
I'm also going to put a video packer/cd writer into the program my program is detailed so I've also started doing a help web page for it,

thanks for all your help

[Lord Orwell]

GOOD LUCK with the cd-writer. You will see what i mean...

[c_owl]

Set fso = CreateObject("Scripting.FileSystemObject")
    Set drv = fso.GetDrive(fso.GetDriveName((Mid(drive.Caption, 1, 2))))
    Debug.Print "-------------------------------"

    Dim curDebug As Currency
    curDebug = CCur(drv.AvailableSpace)
dd=FileLen(Format.Label2.Caption + Format.Label1.Caption)
msgbox dd - curdebug

hi
im trying to create some code that will check if a drive has more space than the file im copying to the drive. if he file is larger than the space on the drive then returns error message.
has any tryed this as i cannot get it to work. i have tryed using the above to return the the file and drive size witch is ok but i cannot work out how to compaire them

any thought would be great