Solved

Find all file extensions in folder and sub folders and save to access table

Posted on 2012-03-20
10
479 Views
Last Modified: 2012-03-21
I have an access table tblExtensions with one filed Extension.
Is there a way to search a folder and all sub folders (i.e. C:\Users) and return the file extensions of every file to the tblExtensions table?

I am trying to build a list of file types in a diretory.

Thank you in advance.

Steve
0
Comment
Question by:Scamquist
  • 5
  • 3
  • 2
10 Comments
 
LVL 8

Expert Comment

by:fundacionrts
ID: 37744529
Dim objFileSystem

Sub insertExtension(strExtension)
      ojConnection.Execute "INSERT INTO tblExtensions(Extension) VALUES (""" & strExtension & """)"
End Sub

Function subfolders(strFolder)
      Dim objCurrent, objFolder, objFile
      Set objCurrent = objFileSystem.GetFolder(strFolder)
      
      For Each objFile In objCurrent.Files
            insertExtension objFileSystem.GetExtensionName(objFile.Name)
      Next
      For Each objFolder In objCurrent.Subfolders
            WScript.Echo objFolder.Path
            subfolders objFolder.Path
      Next
End Function

Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set ojConnection = CreateObject("ADODB.Connection")
ojConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\path\to\database.mdb"

subfolders "c:\path\to\folder\"

ojConnection.Close

Set ojConnection = Nothing
Set objFileSystem = Nothing
0
 
LVL 1

Author Comment

by:Scamquist
ID: 37745496
I am confused.  How do I incorporate this into my database?
0
 
LVL 8

Expert Comment

by:fundacionrts
ID: 37746032
Ups, excuse me! I understood that you need a "external" script and not a MS Access script! (my English is not very good). Sorry!
0
 
LVL 74

Accepted Solution

by:
Jeffrey Coachman earned 500 total points
ID: 37747440
Check this.

Make a table named: tblExtensions
Fields:
ID (AutoNumber)
Extension (Text, 5 characters)

Make a table called: tblUniqueExtensions
Fields:
Extension (Text, 5 characters)

(Disclaimer: Original code modified form here:
http://www.ammara.com/access_image_faq/recursive_folder_search.html)

Put this code on a button on a form:

Dim colFiles As New Collection
    RecursiveDir colFiles, "C:\YourFolder", "*.*", True
'    CurrentDb.Execute "DROP TABLE tblUniqueExtensions", dbFailOnError
   
    CurrentDb.Execute "DELETE * FROM tblExtensions", dbFailOnError

    Dim vFile As Variant
    For Each vFile In colFiles
        Debug.Print vFile
        CurrentDb.Execute "INSERT INTO tblExtensions (Extension) VALUES(" & "'" & Right(vFile, 3) & "'" & ")", dbFailOnError
    Next vFile
   
    CurrentDb.Execute "SELECT tblExtensions.Extension INTO tblUniqueExtensions FROM tblExtensions GROUP BY tblExtensions.Extension", dbFailOnError





Put this code in a Module:

Public Function RecursiveDir(colFiles As Collection, strFolder As String, strFileSpec As String, bIncludeSubfolders As Boolean)

    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    'Add files in strFolder matching strFileSpec to colFiles
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colFiles.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Fill colFolders with list of subdirectories of strFolder
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop

        'Call RecursiveDir for each subfolder in colFolders
        For Each vFolderName In colFolders
            Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
        Next vFolderName
    End If

End Function

Public Function TrailingSlash(strFolder As String) As String
    If Len(strFolder) > 0 Then
        If Right(strFolder, 1) = "\" Then
            TrailingSlash = strFolder
        Else
            TrailingSlash = strFolder & "\"
        End If
    End If
End Function



This worked fine for me.
The File Upload function here is not working right now.

;-)

JeffCoachman
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 37747465
Actually this is the correct code for the button...

Dim colFiles As New Collection
    RecursiveDir colFiles, "C:\YourFolder", "*.*", True
    CurrentDb.Execute "DROP TABLE tblUniqueExtensions", dbFailOnError
   
    CurrentDb.Execute "DELETE * FROM tblExtensions", dbFailOnError

    Dim vFile As Variant
    For Each vFile In colFiles
        Debug.Print vFile
        CurrentDb.Execute "INSERT INTO tblExtensions (Extension) VALUES(" & "'" & Right(vFile, 3) & "'" & ")", dbFailOnError
    Next vFile
   
    CurrentDb.Execute "SELECT tblExtensions.Extension INTO tblUniqueExtensions FROM tblExtensions GROUP BY tblExtensions.Extension", dbFailOnError
0
Free Gift Card with Acronis Backup Purchase!

Backup any data in any location: local and remote systems, physical and virtual servers, private and public clouds, Macs and PCs, tablets and mobile devices, & more! For limited time only, buy any Acronis backup products and get a FREE Amazon/Best Buy gift card worth up to $200!

 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 37747499
...More refinements.

The above code will only get the last three characters of the extension
(This will truncate many of the newer/longer file extensions like .accdb, and .HTML)
This code takes the last 5 characters:

Dim colFiles As New Collection
    RecursiveDir colFiles, "C:\YourFolder", "*.*", True
    CurrentDb.Execute "DROP TABLE tblUniqueExtensions", dbFailOnError
   
    CurrentDb.Execute "DELETE * FROM tblExtensions", dbFailOnError

    Dim vFile As Variant
    For Each vFile In colFiles
        Debug.Print vFile
        CurrentDb.Execute "INSERT INTO tblExtensions (Extension) VALUES(" & "'" & Right(vFile, Len(vFile) - InStr(vFile, ".")) & "'" & ")", dbFailOnError
    Next vFile
   
    CurrentDb.Execute "SELECT tblExtensions.Extension INTO tblUniqueExtensions FROM tblExtensions GROUP BY tblExtensions.Extension", dbFailOnError
0
 
LVL 1

Author Comment

by:Scamquist
ID: 37748263
I added my parent folder location.
When I run the code I get the error

Run-time error '52':      
Bad file name or number

Debug stops on the last line below.

Public Function RecursiveDir(colFiles As Collection, strFolder As String, strFileSpec As String, bIncludeSubfolders As Boolean)

    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    'Add files in strFolder matching strFileSpec to colFiles
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 37749068
Here is the sample db that worked fine for me...
Access-EEQ27640954Recursion--Rec.mdb
0
 
LVL 1

Author Closing Comment

by:Scamquist
ID: 37749702
Jeff,
I have not found the difference in my code and yours, but the database you provided worked.  I was doing a similar recursive search to find files.  I just couldn't get the extension only part.

Thank you for the assist.
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 37749891
Great!

As you can see, I simply modified the code from:
http://www.ammara.com/access_image_faq/recursive_folder_search.html

So I could not simply post the code here without giving the proper credit...

;-)

Jeff
0

Featured Post

Get up to 2TB FREE CLOUD per backup license!

An exclusive Black Friday offer just for Expert Exchange audience! Buy any of our top-rated backup solutions & get up to 2TB free cloud per system! Perform local & cloud backup in the same step, and restore instantly—anytime, anywhere. Grab this deal now before it disappears!

Join & Write a Comment

This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28455246.html)28455246) Here (http…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now