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
Solved

VBA to return list of all files with a particular file extension across all a user's logical drives

Posted on 2014-01-23
1
846 Views
Last Modified: 2014-01-25
Hello Experts,

I have an Front end/back end Access application where the end users can have multiple back end files. All these files end in ".eve". More frequently than I would like end users "forget' where the back end files have been created. I can get them a list of files on a logical drive (example C: drive) using command line window with:

CD C:\
dir *.eve /S >C:\SEMP\evefiles.txt

I am after a VBA routine to cycle through all their logical drives and list the .eve files in each drive/folder with  "Last Accessed" information. I am familiar with GetLogicalDriveStrings but can't put put it all together into a single routine an end user can call simply.
0
Comment
Question by:JohnCling
1 Comment
 
LVL 7

Accepted Solution

by:
Beneford earned 500 total points
ID: 39806135
This should do what you need.

Option Compare Database
Option Explicit

Dim fso As New FileSystemObject
Dim fld As Folder

Private Declare Function GetLogicalDriveStrings Lib "kernel32" _
    Alias "GetLogicalDriveStringsA" _
    (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

' Taken from http://support.microsoft.com/kb/291573
Private Function GetDriveStrings() As String
    ' Wrapper for calling the GetLogicalDriveStrings API
    
    Dim result As Long          ' Result of our api calls
    Dim strDrives As String     ' String to pass to api call
    Dim lenStrDrives As Long    ' Length of the above string
    
    ' Call GetLogicalDriveStrings with a buffer size of zero to
    ' find out how large our stringbuffer needs to be
    result = GetLogicalDriveStrings(0, strDrives)
    
    strDrives = String(result, 0)
    lenStrDrives = result
    
    ' Call again with our new buffer
    result = GetLogicalDriveStrings(lenStrDrives, strDrives)
    
    If result = 0 Then
        ' There was some error calling the API
        ' Pass back an empty string
        ' NOTE - TODO: Implement proper error handling here
        GetDriveStrings = ""
    Else
        GetDriveStrings = strDrives
    End If
End Function

' adapted from https://support.microsoft.com/kb/185601/EN-US
Sub FindFile(ByVal sFol As String, sFile As String)
   Dim tFld As Folder, tFil As File, FileName As String
   
   Dim foundFile As String
   Dim foundDetail As String
   On Error GoTo Catch
   Set fld = fso.GetFolder(sFol)
   FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or vbReadOnly) 'Or vbHidden Or vbSystem
   While Len(FileName) <> 0
      foundFile = fso.BuildPath(fld.Path, FileName)
      foundDetail = FileDateTime(foundFile)
      FileList.AddItem foundDetail & " -> " & foundFile  ' Load ListBox
      FileName = Dir()  ' Get next file
      DoEvents
   Wend
   lStatus.Caption = "Searching " & vbCrLf & fld.Path & "..."
   If fld.SubFolders.Count > 0 Then
      For Each tFld In fld.SubFolders
         DoEvents
         FindFile tFld.Path, sFile
      Next
   End If
   Exit Sub
Catch:  FileName = ""
       Resume Next
End Sub

Private Sub bSearch_Click()
    Dim ds As String
    Dim i As Integer
    ds = GetDriveStrings
    For i = 1 To Len(ds) Step 4
        FindFile Mid(ds, i, 3), SearchFor
    Next i
    
End Sub

Private Sub Command44_Click()
    lStatus.Caption = ""
    While FileList.ListCount > 0
        FileList.RemoveItem (0)
    Wend
End Sub

Open in new window

0

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…

856 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