By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
435,264 Members | 1,056 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 435,264 IT Pros & Developers. It's quick & easy.

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

P: 8
I could not get my head round filesystemobject syntax and more importantly how to add this to db.

Can you explain in filesystemobjectexample 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.
May 1 '10 #1
Share this Question
Share on Google+
4 Replies


NeoPa
Expert Mod 15k+
P: 31,494
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.
May 2 '10 #2

NeoPa
Expert Mod 15k+
P: 31,494
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.
Expand|Select|Wrap|Line Numbers
  1. Private Function DoFolder(folParent As Folder, rs As DAO.Recordset) As String
  2.     Dim fol As Folder
  3.     Dim fil As File
  4.     Dim lngSize As Long, lngUnit As Long, lngID As Long
  5.     Dim lngFileSize As Long, lngFileUnit As Long
  6.     Dim strSize As String
  7.  
  8.     lngUnit = 0
  9.     With folParent
  10.         Call rs.AddNew
  11.         rs!RootFolder = Me.txtRoot
  12.         rs!FullName = Replace(.ParentFolder & ("\" + .Name), ":\\", ":\")
  13.         rs!Drive = .Drive
  14.         rs!Parent = .ParentFolder
  15.         rs!Name = .Name
  16.         If .IsRootFolder Then
  17.             rs!Name = .Drive.VolumeName
  18.         Else
  19.             rs!Creation = .DateCreated
  20.             rs!Modified = .DateLastModified
  21.             rs!Accessed = .DateLastAccessed
  22.         End If
  23.         rs!FileType = .Type
  24.         lngID = rs!fileID
  25.         Call rs.Update
  26.         For Each fol In .SubFolders
  27.             strSize = DoFolder(folParent:=fol, rs:=rs)
  28.             Call AddSize(lngSize:=lngSize, _
  29.                          lngUnit:=lngUnit, _
  30.                          lngAdd:=Split(strSize, ",")(0), _
  31.                          lngAddUnit:=Split(strSize, ",")(1))
  32.         Next fol
  33.         For Each fil In .Files
  34.             With fil
  35.                 lngFileUnit = IIf(.Size > 2147483647, 1, 0)
  36.                 lngFileSize = .Size / (1024 ^ lngFileUnit)
  37.                 Call rs.AddNew
  38.                 rs!RootFolder = Me.txtRoot
  39.                 rs!FullName = Left(Replace(.ParentFolder & ("\" + .Name), _
  40.                                            ":\\", ":\"), 255)
  41.                 rs!Drive = .Drive
  42.                 rs!Parent = .ParentFolder
  43.                 rs!Name = .Name
  44.                 rs!Creation = .DateCreated
  45.                 rs!Modified = .DateLastModified
  46.                 rs!Accessed = .DateLastAccessed
  47.                 rs!FileType = Left(.Type, 50)
  48.                 rs!Size = lngFileSize
  49.                 rs!Unit = varUnits(lngFileUnit)
  50.                 Call rs.Update
  51.                 Call AddSize(lngSize, lngUnit, lngFileSize, lngFileUnit)
  52.             End With
  53.         Next fil
  54.     End With
  55.     With rs
  56.         Call rs.Seek(Comparison:="=", Key1:=lngID)
  57.         Call .Edit
  58.         !Size = lngSize
  59.         !Unit = varUnits(lngUnit)
  60.         Call .Update
  61.     End With
  62.     DoFolder = lngSize & "," & lngUnit
  63. 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 :
Expand|Select|Wrap|Line Numbers
  1. Select Case UCase(Mid(.Name, InStrRev(.Name, ".")))
  2. 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) :
Expand|Select|Wrap|Line Numbers
  1. End Select
That sequence of code would now look like :
Expand|Select|Wrap|Line Numbers
  1.         For Each fil In .Files
  2.             With fil
  3.                 Select Case UCase(Mid(.Name, InStrRev(.Name, ".")))
  4.                 Case ".JPG"
  5.                     lngFileUnit = IIf(.Size > 2147483647, 1, 0)
  6.                     lngFileSize = .Size / (1024 ^ lngFileUnit)
  7.                     Call rs.AddNew
  8.                     rs!RootFolder = Me.txtRoot
  9.                     rs!FullName = Left(Replace(.ParentFolder & ("\" + .Name), _
  10.                                                ":\\", ":\"), 255)
  11.                     rs!Drive = .Drive
  12.                     rs!Parent = .ParentFolder
  13.                     rs!Name = .Name
  14.                     rs!Creation = .DateCreated
  15.                     rs!Modified = .DateLastModified
  16.                     rs!Accessed = .DateLastAccessed
  17.                     rs!FileType = Left(.Type, 50)
  18.                     rs!Size = lngFileSize
  19.                     rs!Unit = varUnits(lngFileUnit)
  20.                     Call rs.Update
  21.                     Call AddSize(lngSize, lngUnit, lngFileSize, lngFileUnit)
  22.                 End Select
  23.             End With
  24.         Next fil
May 2 '10 #3

P: 8
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;

Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2. Option Explicit
  3.  
  4. 'Handle lack of access to certain folders
  5. 'Handle rounded integer division by 1024
  6.  
  7. Private Const conClear As String = _
  8.                   "DELETE " & _
  9.                   "FROM [%T] " & _
  10.                   "WHERE [RootFolder]='%D'"
  11. Private Const conUnits As String = _
  12.                   "Bytes," & _
  13.                   "KiloBytes," & _
  14.                   "MegaBytes," & _
  15.                   "GigaBytes," & _
  16.                   "TeraBytes," & _
  17.                   "PetaBytes," & _
  18.                   "ExaBytes," & _
  19.                   "ZettaBytes," & _
  20.                   "YottaBytes"
  21.  
  22. Private varUnits As Variant             'Array
  23. Public NumAddFiles As Integer
  24. Public TotalFilesProcessed As Integer
  25. Public TotalJPEGSProcessed As Integer
  26.  
  27. Sub StatusBar(Optional Msg As Variant)
  28. Dim Temp As Variant
  29.  
  30. ' if the Msg variable is omitted or is empty, return the control of the status bar to Access
  31.  
  32. If Not IsMissing(Msg) Then
  33.  If Msg <> "" Then
  34.   Temp = SysCmd(acSysCmdSetStatus, Msg)
  35.  Else
  36.   Temp = SysCmd(acSysCmdClearStatus)
  37.  End If
  38. Else
  39.   Temp = SysCmd(acSysCmdClearStatus)
  40. End If
  41. End Sub
  42.  
  43. Private Sub cmdTrawl_Click()
  44.     Dim strTable As String, strSQL As String
  45.     Dim lngErrNo As Long
  46.     Dim fso As FileSystemObject
  47.     Dim fol As Folder
  48.     Dim cn As New ADODB.Connection
  49.     Dim rs As New ADODB.Recordset
  50.     Dim SQL As String
  51.     SQL = "select * from dbo.tblFileStructure"
  52.  
  53.     cn.ConnectionTimeout = 300
  54.     ' DSN connection
  55.     cn.Open "DSN=DHANCOCK;Trusted_Connection=yes;"
  56.  
  57.     If cn.State = adStateOpen Then
  58.       MsgBox "Welcome to Images DB!"
  59.     Else
  60.       MsgBox "Sorry. Error in connection."
  61.     End If
  62.     rs.Open SQL, cn, adOpenKeyset, adLockOptimistic
  63.  
  64.     On Error Resume Next
  65.     NumAddFiles = 0
  66.     TotalFilesProcessed = 0
  67.     TotalJPEGSProcessed = 0
  68.  
  69.     StatusBar "Trawling: " & Me.txtRoot
  70.     Set fso = CreateObject("Scripting.FileSystemObject")
  71.     If Err > 0 Then
  72.         Call MsgBox("Unable to access Scripting.FileSystemObject")
  73.         Exit Sub
  74.     End If
  75.  
  76.     Set fol = fso.GetFolder(FolderPath:=Me.txtRoot)
  77.     If Err > 0 Then
  78.         Call MsgBox("Invalid path - """ & Me.txtRoot & """.")
  79.         Exit Sub
  80.     End If
  81.  
  82.     strTable = "tblFileStructure"
  83.  
  84.     If Err > 0 Then
  85.         Call MsgBox("Unable to access """ & strTable & """.")
  86.         Exit Sub
  87.     End If
  88.     varUnits = Split(conUnits, ",")
  89.     On Error GoTo 0
  90.     Call DoFolder(folParent:=fol, rs:=rs)
  91.     Call rs.Close
  92.     Debug.Print "Added: "; NumAddFiles; " Files to DB"
  93.    StatusBar "Jpegs Processed: " & TotalJPEGSProcessed
  94. End Sub
  95.  
  96. Private Function DoFolder(folParent As Folder, rs As ADODB.Recordset) As String
  97.     Dim fol As Folder
  98.     Dim fil As File
  99.     Dim lngSize As Long, lngUnit As Long, lngID As Long
  100.     Dim lngFileSize As Long, lngFileUnit As Long
  101.     Dim strSize As String
  102.     Dim strCriteria As String
  103.     Dim FoundFiles As Integer
  104.  
  105.     lngUnit = 0
  106.     With folParent
  107.         For Each fol In .SubFolders
  108.             strSize = DoFolder(folParent:=fol, rs:=rs)
  109.             Call AddSize(lngSize:=lngSize, _
  110.                          lngUnit:=lngUnit, _
  111.                          lngAdd:=Split(strSize, ",")(0), _
  112.                          lngAddUnit:=Split(strSize, ",")(1))
  113.         Next fol
  114.         For Each fil In .Files
  115.         TotalFilesProcessed = TotalFilesProcessed + 1
  116.         StatusBar "Trawling: " & folParent & " - " & TotalFilesProcessed & " Files Processed"
  117.  
  118.             With fil
  119.                 lngFileUnit = IIf(.Size > 2147483647, 1, 0)
  120.                 lngFileSize = .Size / (1024 ^ lngFileUnit)
  121.  
  122.                 If fil.Type <> "JPEG image" Then
  123.                 GoTo nextrec
  124.                 Else
  125.                 'test to see if record exisits 1st
  126.                 TotalJPEGSProcessed = TotalJPEGSProcessed + 1
  127.                 strCriteria = "[FullName] = '" & fil.ParentFolder + "\" + fil.Name & "'"
  128. ' **** THIS IS WHERE I GET STUCK, SEARCH COMES BACK WITH RESULT '-1'..commented out rs.find as it simply did not work
  129.                 rs.MoveFirst
  130.                 'rs.Find strCriteria, 0
  131.                 MsgBox (rs.RecordCount)
  132.                 MsgBox (rs!FullName)
  133.                     If rs.RecordCount = 1 Then
  134.                         'record exisits, dont creat a new one.
  135.                         'Debug.Print rs.AbsolutePosition; "RECORD EXISTS"; strCriteria
  136.                         Else
  137.                         'record does not exist and process ADDNEW
  138.                         Debug.Print "ADD " & strCriteria
  139.                         Call rs.AddNew
  140.                         rs!FullName = Left(Replace(.ParentFolder & ("\" + .Name), _
  141.                                                    ":\\", ":\"), 255)
  142.                         rs!Drive = .Drive
  143.                         rs!Parent = .ParentFolder
  144.                         rs!Name = .Name
  145.                         rs!Creation = .DateCreated
  146.                         rs!Modified = .DateLastModified
  147.                         rs!Accessed = .DateLastAccessed
  148.                         rs!FileType = Left(.Type, 50)
  149.                         rs!Size = lngFileSize
  150.                         rs!Unit = varUnits(lngFileUnit)
  151.                         Call rs.Update
  152.                         NumAddFiles = NumAddFiles + 1
  153.                         Call AddSize(lngSize, lngUnit, lngFileSize, lngFileUnit)
  154.                     End If 'end of if record exists
  155.                 End If 'end of if jpeg file
  156.             End With
  157. nextrec:
  158.         Next fil
  159.     End With
  160.     With rs
  161.     End With
  162.     DoFolder = lngSize & "," & lngUnit
  163. End Function
  164.  
  165. Private Sub AddSize(ByRef lngSize As Long, _
  166.                     ByRef lngUnit As Long, _
  167.                     ByVal lngAdd As Long, _
  168.                     ByVal lngAddUnit As Long)
  169.     Dim lngWrk As Long, lngSmall As Long
  170.  
  171.     If lngUnit > lngAddUnit Then
  172.         lngWrk = 1024 ^ (lngUnit - lngAddUnit)
  173.         lngSmall = lngAdd \ lngWrk
  174.         lngAdd = lngSmall + _
  175.                  IIf(lngAdd - (lngSmall * lngWrk) >= (lngWrk / 2), 1, 0)
  176.     ElseIf lngUnit < lngAddUnit Then
  177.         lngWrk = 1024 ^ (lngAddUnit - lngUnit)
  178.         lngUnit = lngAddUnit
  179.         lngSmall = lngSize \ lngWrk
  180.         lngSize = lngSmall + _
  181.                   IIf(lngSize - (lngSmall * lngWrk) >= (lngWrk / 2), 1, 0)
  182.     End If
  183.     On Error GoTo ErrAS
  184.     lngSize = lngSize + lngAdd
  185.     Exit Sub
  186.  
  187. ErrAS:
  188.     If Err = 6 Then
  189.         lngUnit = lngUnit + 1
  190.         lngSmall = lngAdd \ 1024
  191.         lngAdd = lngSmall + IIf(lngAdd - (lngSmall * 1024) >= 512, 1, 0)
  192.         lngSmall = lngSize \ 1024
  193.         lngSize = lngSmall + IIf(lngSize - (lngSmall * 1024) >= 512, 1, 0)
  194.         Resume
  195.     End If
  196. End Sub
  197.  
  198. Private Sub cmdExit_Click()
  199.     Call DoCmd.Close
  200. End Sub
  201.  
  202. Private Sub Form_Load()
  203. txtRoot.Value = "M:\Data\My Pictures\Holiday Pics"
  204. End Sub
  205.  
  206.  
  207.  
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
May 3 '10 #4

NeoPa
Expert Mod 15k+
P: 31,494
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.
May 3 '10 #5

Post your reply

Sign in to post your reply or Sign up for a free account.