How do i use FileSystemObject to search for particular file type?

[gingernob]

I could not get my head round filesystemobjec t syntax and more importantly how to add this to db.

Can you explain in filesystemobjec texample posted, how do i define only to search for particular file types, eg .jpg files?

As u may gather, your coding level is just a wee bit above my novice level, but i grasp the principles of what, and more importantly how you are doing what you are doing. Just syntax issue now defining this particular point. Then I feel comfortable I can tweak the db format to my own uses and continue from there.

[NeoPa]

This question pertains to Table to include folders in a directory - Multilevel.

Hi GingerNob.
Welcome to Bytes!

I should explain, as you're new, that we like to keep separate questions in their own threads. It makes dealing with the various questions more manageable. You may want to browse the FAQ section, available at the top of every page to familiarise yourself with some of our specific rules. They are largely in line with general forum etiquette elsewhere too, so should prove useful right across the web.

Another issue you will find mentioned there is the text-type abbreviations, which are also frowned upon (outlawed), as they make communication more fragile. Communication being so critically important with such technical questions.

Right. Admin hat off & Expert hat back on now.

Give me a quick chance to check this out then I'll post something that should help you on your way.

[NeoPa]

Let's start by including the code in the function DoFolder(), so that anyone reading this can follow. It's a little long, but doesn't all need to be read in all circumstances.

Private Function DoFolder(folParent As Folder, rs As DAO.Recordset) As String
    Dim fol As Folder
    Dim fil As File
    Dim lngSize As Long, lngUnit As Long, lngID As Long
    Dim lngFileSize As Long, lngFileUnit As Long
    Dim strSize As String

    lngUnit = 0
    With folParent
        Call rs.AddNew
        rs!RootFolder = Me.txtRoot
        rs!FullName = Replace(.ParentFolder & ("\" + .Name), ":\\", ":\")
        rs!Drive = .Drive
        rs!Parent = .ParentFolder
        rs!Name = .Name
        If .IsRootFolder Then
            rs!Name = .Drive.VolumeName
        Else
            rs!Creation = .DateCreated
            rs!Modified = .DateLastModified
            rs!Accessed = .DateLastAccessed
        End If
        rs!FileType = .Type
        lngID = rs!fileID
        Call rs.Update
        For Each fol In .SubFolders
            strSize = DoFolder(folParent:=fol, rs:=rs)
            Call AddSize(lngSize:=lngSize, _
                         lngUnit:=lngUnit, _
                         lngAdd:=Split(strSize, ",")(0), _
                         lngAddUnit:=Split(strSize, ",")(1))
        Next fol
        For Each fil In .Files
            With fil
                lngFileUnit = IIf(.Size > 2147483647, 1, 0)
                lngFileSize = .Size / (1024 ^ lngFileUnit)
                Call rs.AddNew
                rs!RootFolder = Me.txtRoot
                rs!FullName = Left(Replace(.ParentFolder & ("\" + .Name), _
                                           ":\\", ":\"), 255)
                rs!Drive = .Drive
                rs!Parent = .ParentFolder
                rs!Name = .Name
                rs!Creation = .DateCreated
                rs!Modified = .DateLastModified
                rs!Accessed = .DateLastAccessed
                rs!FileType = Left(.Type, 50)
                rs!Size = lngFileSize
                rs!Unit = varUnits(lngFileUnit)
                Call rs.Update
                Call AddSize(lngSize, lngUnit, lngFileSize, lngFileUnit)
            End With
        Next fil
    End With
    With rs
        Call rs.Seek(Comparison:="=", Key1:=lngID)
        Call .Edit
        !Size = lngSize
        !Unit = varUnits(lngUnit)
        Call .Update
    End With
    DoFolder = lngSize & "," & lngUnit
End Function

The lines we're mainly interested are #33 to #53, where each file that is found is processed. What we need to do, as the .Files collection of the folder object contains all available files by definition, is to add code in there so that only files that match your required format are processed. IE. All the files we don't want will be checked but ignored. To do this we add some lines just after the With fil line at #35 :

Select Case UCase(Mid(.Name, InStrRev(.Name, ".")))
Case ".JPG"

This could easily have been done with an If statement instead, but extending the .JPG to include multiple options is better done with Select Case.

As well as indenting the code inbetween, we also need to add the following before the End With line (originally #52) :

End Select

That sequence of code would now look like :

        For Each fil In .Files
            With fil
                Select Case UCase(Mid(.Name, InStrRev(.Name, ".")))
                Case ".JPG"
                    lngFileUnit = IIf(.Size > 2147483647, 1, 0)
                    lngFileSize = .Size / (1024 ^ lngFileUnit)
                    Call rs.AddNew
                    rs!RootFolder = Me.txtRoot
                    rs!FullName = Left(Replace(.ParentFolder & ("\" + .Name), _
                                               ":\\", ":\"), 255)
                    rs!Drive = .Drive
                    rs!Parent = .ParentFolder
                    rs!Name = .Name
                    rs!Creation = .DateCreated
                    rs!Modified = .DateLastModified
                    rs!Accessed = .DateLastAccessed
                    rs!FileType = Left(.Type, 50)
                    rs!Size = lngFileSize
                    rs!Unit = varUnits(lngFileUnit)
                    Call rs.Update
                    Call AddSize(lngSize, lngUnit, lngFileSize, lngFileUnit)
                End Select
            End With
        Next fil

[gingernob]

Your solution but with SQL backend

Hi, thanks so much.
Actually, knowing that people like yourself prefer people like me to learn rather than expect other people to provide solutions (quite right too), I did 'play' and did roughly what you suggested but with an IF. Please also note I used a slightly different variation on your test, checking for fil.type...
your code; how would it deal with a file who's name contains more than 1 '.' ?, but as you say CASE is more tidy and efficient so I will change.
If I may follow on with this thread (as it provides a perfect example) I then migrated the Database to SQL server 2008. Sadly it then failed to work.
I have spent all yesterday trying to now understand ADO and convert your example to ADO as I read I have to use ADO to connect to a SQL backend.
Is this correct? and if so, any pointers. I really have tried. I can connect to the database (confirming using the cn.state command) but I am then trying to use your existing code but compare existing records to see if the record exists for the file found.
I think it will be better if I add the complete altered code for your review;

Option Compare Database
Option Explicit

'Handle lack of access to certain folders
'Handle rounded integer division by 1024

Private Const conClear As String = _
                  "DELETE " & _
                  "FROM [%T] " & _
                  "WHERE [RootFolder]='%D'"
Private Const conUnits As String = _
                  "Bytes," & _
                  "KiloBytes," & _
                  "MegaBytes," & _
                  "GigaBytes," & _
                  "TeraBytes," & _
                  "PetaBytes," & _
                  "ExaBytes," & _
                  "ZettaBytes," & _
                  "YottaBytes"

Private varUnits As Variant             'Array
Public NumAddFiles As Integer
Public TotalFilesProcessed As Integer
Public TotalJPEGSProcessed As Integer

Sub StatusBar(Optional Msg As Variant)
Dim Temp As Variant

' if the Msg variable is omitted or is empty, return the control of the status bar to Access

If Not IsMissing(Msg) Then
 If Msg <> "" Then
  Temp = SysCmd(acSysCmdSetStatus, Msg)
 Else
  Temp = SysCmd(acSysCmdClearStatus)
 End If
Else
  Temp = SysCmd(acSysCmdClearStatus)
End If
End Sub

Private Sub cmdTrawl_Click()
    Dim strTable As String, strSQL As String
    Dim lngErrNo As Long
    Dim fso As FileSystemObject
    Dim fol As Folder
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim SQL As String
    SQL = "select * from dbo.tblFileStructure"
    
    cn.ConnectionTimeout = 300
    ' DSN connection
    cn.Open "DSN=DHANCOCK;Trusted_Connection=yes;"

    If cn.State = adStateOpen Then
      MsgBox "Welcome to Images DB!"
    Else
      MsgBox "Sorry. Error in connection."
    End If
    rs.Open SQL, cn, adOpenKeyset, adLockOptimistic
    
    On Error Resume Next
    NumAddFiles = 0
    TotalFilesProcessed = 0
    TotalJPEGSProcessed = 0
    
    StatusBar "Trawling: " & Me.txtRoot
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Err > 0 Then
        Call MsgBox("Unable to access Scripting.FileSystemObject")
        Exit Sub
    End If

    Set fol = fso.GetFolder(FolderPath:=Me.txtRoot)
    If Err > 0 Then
        Call MsgBox("Invalid path - """ & Me.txtRoot & """.")
        Exit Sub
    End If

    strTable = "tblFileStructure"

    If Err > 0 Then
        Call MsgBox("Unable to access """ & strTable & """.")
        Exit Sub
    End If
    varUnits = Split(conUnits, ",")
    On Error GoTo 0
    Call DoFolder(folParent:=fol, rs:=rs)
    Call rs.Close
    Debug.Print "Added: "; NumAddFiles; " Files to DB"
   StatusBar "Jpegs Processed: " & TotalJPEGSProcessed
End Sub

Private Function DoFolder(folParent As Folder, rs As ADODB.Recordset) As String
    Dim fol As Folder
    Dim fil As File
    Dim lngSize As Long, lngUnit As Long, lngID As Long
    Dim lngFileSize As Long, lngFileUnit As Long
    Dim strSize As String
    Dim strCriteria As String
    Dim FoundFiles As Integer
    
    lngUnit = 0
    With folParent
        For Each fol In .SubFolders
            strSize = DoFolder(folParent:=fol, rs:=rs)
            Call AddSize(lngSize:=lngSize, _
                         lngUnit:=lngUnit, _
                         lngAdd:=Split(strSize, ",")(0), _
                         lngAddUnit:=Split(strSize, ",")(1))
        Next fol
        For Each fil In .Files
        TotalFilesProcessed = TotalFilesProcessed + 1
        StatusBar "Trawling: " & folParent & " - " & TotalFilesProcessed & " Files Processed"
            
            With fil
                lngFileUnit = IIf(.Size > 2147483647, 1, 0)
                lngFileSize = .Size / (1024 ^ lngFileUnit)
                
                If fil.Type <> "JPEG image" Then
                GoTo nextrec
                Else
                'test to see if record exisits 1st
                TotalJPEGSProcessed = TotalJPEGSProcessed + 1
                strCriteria = "[FullName] = '" & fil.ParentFolder + "\" + fil.Name & "'"
' **** THIS IS WHERE I GET STUCK, SEARCH COMES BACK WITH RESULT '-1'..commented out rs.find as it simply did not work
                rs.MoveFirst
                'rs.Find strCriteria, 0
                MsgBox (rs.RecordCount)
                MsgBox (rs!FullName)
                    If rs.RecordCount = 1 Then
                        'record exisits, dont creat a new one.
                        'Debug.Print rs.AbsolutePosition; "RECORD EXISTS"; strCriteria
                        Else
                        'record does not exist and process ADDNEW
                        Debug.Print "ADD " & strCriteria
                        Call rs.AddNew
                        rs!FullName = Left(Replace(.ParentFolder & ("\" + .Name), _
                                                   ":\\", ":\"), 255)
                        rs!Drive = .Drive
                        rs!Parent = .ParentFolder
                        rs!Name = .Name
                        rs!Creation = .DateCreated
                        rs!Modified = .DateLastModified
                        rs!Accessed = .DateLastAccessed
                        rs!FileType = Left(.Type, 50)
                        rs!Size = lngFileSize
                        rs!Unit = varUnits(lngFileUnit)
                        Call rs.Update
                        NumAddFiles = NumAddFiles + 1
                        Call AddSize(lngSize, lngUnit, lngFileSize, lngFileUnit)
                    End If 'end of if record exists
                End If 'end of if jpeg file
            End With
nextrec:
        Next fil
    End With
    With rs
    End With
    DoFolder = lngSize & "," & lngUnit
End Function

Private Sub AddSize(ByRef lngSize As Long, _
                    ByRef lngUnit As Long, _
                    ByVal lngAdd As Long, _
                    ByVal lngAddUnit As Long)
    Dim lngWrk As Long, lngSmall As Long

    If lngUnit > lngAddUnit Then
        lngWrk = 1024 ^ (lngUnit - lngAddUnit)
        lngSmall = lngAdd \ lngWrk
        lngAdd = lngSmall + _
                 IIf(lngAdd - (lngSmall * lngWrk) >= (lngWrk / 2), 1, 0)
    ElseIf lngUnit < lngAddUnit Then
        lngWrk = 1024 ^ (lngAddUnit - lngUnit)
        lngUnit = lngAddUnit
        lngSmall = lngSize \ lngWrk
        lngSize = lngSmall + _
                  IIf(lngSize - (lngSmall * lngWrk) >= (lngWrk / 2), 1, 0)
    End If
    On Error GoTo ErrAS
    lngSize = lngSize + lngAdd
    Exit Sub

ErrAS:
    If Err = 6 Then
        lngUnit = lngUnit + 1
        lngSmall = lngAdd \ 1024
        lngAdd = lngSmall + IIf(lngAdd - (lngSmall * 1024) >= 512, 1, 0)
        lngSmall = lngSize \ 1024
        lngSize = lngSmall + IIf(lngSize - (lngSmall * 1024) >= 512, 1, 0)
        Resume
    End If
End Sub

Private Sub cmdExit_Click()
    Call DoCmd.Close
End Sub

Private Sub Form_Load()
txtRoot.Value = "M:\Data\My Pictures\Holiday Pics"
End Sub

To summarize intended solution; using your existing functionality, but so it is re-usable in the sense that the database does not get 'trashed' but it is a store of existing files, so if you add files to the file system, in my case drive M: testing using my holiday pictures, you re-run the script and it tests for existing records, ignores them if they exist, adds them if they do not. Reason: later I intend to add a field for 'Pic_Info' essentially picture descriptions etc, which I would not want to loose.
Please also note the functionality ALL worked fine until I ported to SQL 2008.
If I am going outside the scope of this thread and you would prefer I created a new one, please let me know.
Kindest Regards
David

[NeoPa]

your code; how would it deal with a file who's name contains more than 1 '.' ?

It does that already by using InStrRev() instead of InStr().

If I may follow on with this thread (as it provides a perfect example) I then migrated the Database to SQL server 2008. Sadly it then failed to work.
I have spent all yesterday trying to now understand ADO and convert your example to ADO as I read I have to use ADO to connect to a SQL backend.
Is this correct? and if so, any pointers.

No. That is not correct. You can attach SQL Server tables and views to an Access database and treat them as local tables.

If this question is now resolved, you need to post your new one in a separate thread. I suggest you take these couple of short answers and work on your database first to a point where you can put a question that reflects your current understanding. The new question, in its own thread, can certainly contain a link through to this one to allow anyone reading it to understand the background.