Solved

Reading the Contents of a Directory In Access VBA

Posted on 2016-09-27
5
47 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 34

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 26

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

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Join & Write a Comment

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Experts-Exchange is a great place to come for help with solutions for your database issues, and many problems are resolved within minutes of being posted.  Others take a little more time and effort and often providing a sample database is very helpf…
Familiarize people with the process of utilizing SQL Server stored procedures from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Micr…
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.

744 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

9 Experts available now in Live!

Get 1:1 Help Now