Solved

Reading the Contents of a Directory In Access VBA

Posted on 2016-09-27
5
68 Views
Last Modified: 2016-09-27
From within my Access 2003 application I would like a routine to read a list of the contents of a directory, including file name, file type, file size and date/time stamp of the file.

I will pass the directory name (example: 'C:\Program\Test')  to the routine and based on the file name and file type I will initiate pertinent logic.
0
Comment
Question by:mlcktmguy
5 Comments
 
LVL 35

Expert Comment

by:PatHartman
ID: 41818765
I use FSO (file system object) to do this but I'm not sure if this library was available for A2003 and I don't have any way to find out.

Using FSO requires a reference to Microsoft Scripting Runtime.  Open any code module and see if you can find that library loaded.  If you can, I'll look for an example tomorrow if no one has posted one by then.  I'm off to play Bridge.
0
 
LVL 35

Accepted Solution

by:
[ fanpages ] earned 500 total points
ID: 41818887
Please see if this suits your requirements:

Public Sub Q_28972810(ByVal strFolder As String)

  Dim objScripting_FileSystemObject         As Object
  Dim objFile                               As Object
  
  Set objScripting_FileSystemObject = CreateObject("Scripting.FileSystemObject")
  
  For Each objFile In objScripting_FileSystemObject.GetFolder(strFolder).Files
  
      Debug.Print objFile.Name, objFile.Type, objFile.Size, objFile.DateCreated, objFile.DateLastAccessed, objFile.DateLastModified
      
  Next objFile
  
  Set objFile = Nothing
  Set objScripting_FileSystemObject = Nothing
  
End Sub

Open in new window


Usage:

Call Q_28972810("C:\Program\Test")
0
 
LVL 27

Expert Comment

by:MacroShadow
ID: 41818911
Here are two options:
Sub Demo(ByVal strFolder As String)
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
     
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strFolder)
     
    For Each objFile In objFolder.Files
        Debug.Print "Name: " & objFile.Name, "Size: " & objFile.Size, "Type: " & objFile.Type, "Date last modified: " & objFile.DateLastModified; "Date created: " & objFile.DateCreated, "Date last accessed: " & objFile.DateLastAccessed,
    Next
     
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
End Sub

Sub Demo2(ByVal strFolder As String)
    Dim objShell As Object
    Dim objDir As Object
    Dim objFile As Object

    Set objShell = CreateObject("Shell.Application")
    Set objDir = objShell.Namespace(strFolder)

    For Each objFile In objDir.Items
        Debug.Print "Name: " & objDir.GetDetailsOf(objFile, 0), "Size: " & objDir.GetDetailsOf(objFile, 1), "Type: " & objDir.GetDetailsOf(objFile, 2), "Date last modified: " & objDir.GetDetailsOf(objFile, 3), "Date created: " & objDir.GetDetailsOf(objFile, 4), "Date last accessed: " & objDir.GetDetailsOf(objFile, 5)
    Next

    Set objShell = Nothin
    Set objDir = Nothin
    Set objFile = Nothin
End Sub

Open in new window

0
 
LVL 19
ID: 41819009
since others have given you code to get information about a file, I will add code to loop through a directory and read filenames into an array then loop through the array
Sub LoopFiles( _
   psPath As String _
   , Optional psMask As String = "*.*")
'read files into array and open each one
's4p
   'PARAMETERS
   '  psPath is path to look in
   '  psMask is what to look for (ie: *.jpg)

  Dim psPathFile As String _
     , sFilename As String _
     , i As Integer

   Dim arrFile() As String
   
   psPath = Trim(psPath)
   If Right(psPath, 1) <> "\" Then
      psPath = psPath & "\"
   End If
   
   'first array element will be 0
   i = -1
   sFilename = Dir(psPath & psMask)
   
   'load files matching mask into an array
   Do While sFilename <> ""
      If (GetAttr(psPath & "\" & sFilename) And vbDirectory) <> vbDirectory Then
         i = i + 1
         'redimension array and preserve previous values
         ReDim Preserve arrFile(i)
         'assign filename to array element
         arrFile(i) = sFilename
      End If
       'get next filename
      sFilename = Dir()
   Loop
   
   'open all the files
   If Not UBound(arrFile) >= 0 Then
      'No Files
      Exit Sub
   End If

   'loop through specified files and open
   For i = LBound(arrFile) To UBound(arrFile)
      psPathFile = psPath & arrFile(i)
      ' ----------------------- do whatever you want
   Next i

End Sub

Open in new window

0
 
LVL 1

Author Closing Comment

by:mlcktmguy
ID: 41819103
Exactly what I was looking for, thanks.
0

Featured Post

Three Reasons Why Backup is Strategic

Backup is strategic to your business because your data is strategic to your business. Without backup, your business will fail. This white paper explains why it is vital for you to design and immediately execute a backup strategy to protect 100 percent of your data.

Question has a verified solution.

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

Suggested Solutions

I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
Preparing an email is something we should all take special care with – especially when the email is for somebody you may not know very well. The pressures of everyday working life stacked with a hectic office environment can make this a real challen…
Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

772 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