Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

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

Posted on 2012-03-20
10
Medium Priority
?
492 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 74

Accepted Solution

by:
Jeffrey Coachman earned 2000 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
 
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

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access custom database properties are useful for storing miscellaneous bits of information in a format that persists through database closing and reopening.  This article shows how to create and use them.
Traditionally, the method to display pictures in Access forms and reports is to first download them from URLs to a folder, record the path in a table and then let the form or report pull the pictures from that folder. But why not let Windows retr…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…

618 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