list all files help needed

[tamathaltarak]

Hi,

I need to build some code to do the following.

Read a directory and all files and all subfolders not matter how deep they go and output this into a database.

e.g. start from a folder say \c\docs\data\

i want to be able to read all folders and files after the above path and output them to the follwing access table.

tblOutput
ID - autonumber
txtFilePath - the actual path of the file e.g. \c\docs\data\
txtFileName - the name of the file including the extension
intFileSize - the size of the file in butes or kilobytes or whatever

Has anyone done this before? and if so can you help me please

thanks

[JoshT]

Try looking at http://www.mvps.org/vbnet/ - they have examples to do what you need for the file searching ( http://www.mvps.org/vbnet/index.html...renumbasic.htm ).

[tamathaltarak]

Hi,

Looked around the 2 sites you gave and found not much joy. After searching these forums I found some code using the FSO. I am able to start in a folder and look for all files and output to a listbox. With some simple mods I managed to output to a database but only the filename including the path. The code I used is below.

Private Sub Command1_Click()
    List1.Clear
    Label2.Caption = "0 files found"
    Screen.MousePointer = vbHourglass
    Call GetAllDirsFrom(Dir1.Path, txtExtension, List1)
    Label2.Caption = List1.ListCount & " files found"
    Screen.MousePointer = vbDefault
End Sub

The above code calls the GetAllDirsFrom

Public Function GetAllDirsFrom(ByVal pstrDir As String, ByVal Extension As String, _
                               ByVal ListBox As ListBox)
    Dim fso As FileSystemObject
    Dim fldrMain As Folder
    Dim fldrsSub As Folders
    Dim fldr As Folder
    Set fso = New FileSystemObject
    Set fldrMain = fso.GetFolder(pstrDir & "\")
    If Right(fldrMain.Path, 1) = "\" Then
        addallfilesfrom Left(fldrMain.Path, Len(fldrMain.Path) - 1), Extension, ListBox
    Else
        addallfilesfrom fldrMain.Path, Extension, ListBox
    End If
    'Recurse subdirectories
    Set fldrsSub = fldrMain.SubFolders
    For Each fldr In fldrsSub
        GetAllDirsFrom fldr.Path, Extension, ListBox
    Next fldr
    ListBox.Refresh
End Function

The above function then calls the addallfilesfrom function

Public Function addallfilesfrom(ByVal pstrDir, ByVal Extension As String, _
                                ByVal ListBox As ListBox)
        
    Dim strfile As String
    Dim strfilename As String
    Dim dblfilesize As Integer
    strfile = pstrDir & "\" & dir(pstrDir & "\*." & Extension)
    Do Until strfile = pstrDir & "\"
        ListBox.AddItem strfile
        ListBox.ListIndex = ListBox.ListCount - 1
        Form1.Label2.Caption = Form1.List1.ListCount & " files found"
        Form1.Label3.Caption = pstrDir
        strfile = pstrDir & "\" & dir
        AddName strfile
        DoEvents
    Loop
End Function

In the above function I added my own function call to AddName

Public Function AddName(strfile As String)
Dim MyDB As Database
Set MyDB = OpenDatabase("c:\documents and settings\leighm\desktop\vb file folder stuff\fileoutput.mdb")
Dim MySQL As String
MySQL = "SELECT * from [tblFilePath]"
Dim rstTemp As Recordset
Set rstTemp = MyDB.OpenRecordset(MySQL)
    With rstTemp
        .AddNew
        !txtFilePath = strfile
'        !txtFileName = not done yet
'        !intFileSize = not done yet
        .Update
    End With
End Function

This all works and updates my table with the filepath etc...

BUT

There is always a but..........hehehe

1) I need to be able to grab the file size for each file and pass this into the AddName fucntion
2) I need to be able to add the filename for each file into the table (not as the above does which will be c:\autoexec.bat)
3) the full path not including the filename to go into !txtFilePath

Can anyone help on this or alter the above code to do this.

The functions came from this forum somewhere (sorry I misplaced the user who uploaded but all credit for the design goes to him/her with the exception of the additional db stuff which I inserted)

[JoshT]

I'm not too familiar with the FSO's capabilities, but if you use the API the WIN32_FIND_DATA structure you pass to FindFirstFile/FindNextFile functions will be set the file size, short name, access dates, etc.

[tamathaltarak]

thanks for the reply Josh,

do you have any example code of this ???

I would rather steer clear of the FSO if possible and would prefer to use the API functions. Speed reasons.

[JoshT]

Here's some code I wrote for finding and deleting *.bak files. See if you can modify it to suit your needs:

Option Explicit
 
Private Const INVALID_HANDLE_VALUE As Long = -1&
Private Const MAX_PATH As Long = 260&
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10&
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20&
Private Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800&
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2&
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80&
Private Const FILE_ATTRIBUTE_READONLY As Long = &H1&
Private Const FILE_ATTRIBUTE_SYSTEM As Long = &H4&
Private Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100&
 
 
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 Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
End Type
 
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
 
Private Declare Function FileTimeToSystemTime Lib "kernel32" _
    (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
 
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) 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
    
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" _
    (ByVal lpFileName As String) As Long
 
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" _
    (ByVal lpFileName As String) As Long
    
Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" _
    (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
 
Public Function FileSearch(ByVal strFolder As String, LB As ListBox) As Boolean
    Dim hFile As Long 'handle to a file
    Dim WFD As WIN32_FIND_DATA
    Dim strTemp As String
    
    If Len(strFolder) <= 0 Then
        FileSearch = False
        Exit Function
    End If
    
    If Right$(strFolder, 1) <> "\" Then
        strFolder = strFolder & "\"
    End If
    
    hFile = FindFirstFile(strFolder & "*" & vbNullChar, WFD)
    
    If hFile <> INVALID_HANDLE_VALUE Then
        strTemp = Left$(WFD.cFileName, InStr(1, WFD.cFileName, vbNullChar) - 1)
        If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
            strTemp = strTemp & "\"
            If Right$(strTemp, 2) <> ".\" Then Call FileSearch(strFolder & strTemp, LB)
        ElseIf Right$(strTemp, 4) = ".bak" Then
            LB.AddItem strFolder & strTemp
        End If
    
        Do While FindNextFile(hFile, WFD)
            strTemp = Left$(WFD.cFileName, InStr(1, WFD.cFileName, vbNullChar) - 1)
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
                strTemp = strTemp & "\"
                If Right$(strTemp, 2) <> ".\" Then Call FileSearch(strFolder & strTemp, LB)
            ElseIf Right$(strTemp, 4) = ".bak" Then
                'older than 7 days
                If DateDiff("d", GetDate(WFD.ftLastAccessTime), Now) > 7 Then LB.AddItem strFolder & strTemp '& " -- " & GetDate(WFD.ftLastAccessTime)
            End If
        Loop
        
        FileSearch = True
        Call FindClose(hFile)
    Else
        FileSearch = False
    End If
    
End Function
 
Private Function GetDate(FT As FILETIME) As String
    Dim ST As SYSTEMTIME
 
    If FileTimeToSystemTime(FT, ST) <> 0 Then
        GetDate = ST.wMonth & "/" & ST.wDay & "/" & ST.wYear
    Else
        GetDate = ""
    End If
End Function