Fast Method for Reading Files in a directory

[dpimental]

I need a fast method for reading files in a directory.

Here is what I am looking for.

Let's say I have The following path "C:/db data/dbf files".

And under that directory I may have 20 subdirectories.
I am looking for .dbf files in the subdirectories.

So, I need to be able to read the "dbf files" directory, and take one directory at a time, open the directory, and for each .dbf file I find, run an import process, pushing the subdirectory name, full path, and .dbf file name to an import function.

Then, go on to the next file, until I have processed all .dbf files in that subdirectory.

Then I go to the next subdirectory, until I have gone through all the subdirectories.

Any takers on this?!

David Please remember to give helpful posts the stars they deserve!
This makes the post more visible to others in need!

 

[danvlas]

Check this and modify it to your needs.
If you call it by StoreResults(".dbf&quot it will search all mapped drives for dbf files.

Function StoreResults(FileName)
On Error Resume Next
Dim mypath, MyDirName, j, Dimension, myFileName, varreturn
Dim NoOfFiles As Long
ReDim fldarray(1, 0)
ReDim resultsarray(0)
DoCmd.Hourglass True
For j = 65 To 90
mypath = Chr(j) & ":\"
1:
MyDirName = Dir(mypath, vbDirectory)
Do While MyDirName <> &quot;&quot;
NoOfFiles = NoOfFiles + 1
If MyDirName <> &quot;.&quot; And MyDirName <> &quot;..&quot; Then
If (GetAttr(mypath & MyDirName) And vbDirectory) = vbDirectory Then
Dimension = UBound(fldarray, 2) + 1
ReDim Preserve fldarray(1, Dimension)
fldarray(0, Dimension - 1) = 0
fldarray(1, Dimension - 1) = mypath & MyDirName & &quot;\&quot;
varreturn = SysCmd(acSysCmdSetStatus, mypath & MyDirName)
End If
End If
MyDirName = Dir
Loop
myFileName = Dir(mypath)
Do Until myFileName = &quot;&quot;
If InStr(myFileName, FileName) > 0 Then
Debug.Print myFileName
Dimension = UBound(resultsarray, 1) + 1
ReDim Preserve resultsarray(Dimension)
resultsarray(Dimension - 1) = mypath & myFileName
' the file is stored in resultsarray
End If
myFileName = Dir
varreturn = SysCmd(acSysCmdSetStatus, mypath & myFileName)
Loop
FileNotFound:
For Dimension = 0 To UBound(fldarray, 2) - 1
If fldarray(0, Dimension) = 0 Then
mypath = fldarray(1, Dimension)
fldarray(0, Dimension) = 1
GoTo 1
End If
Next Dimension
NextDrive:
Next j
varreturn = SysCmd(acSysCmdSetStatus, UBound(resultsarray, 1) & &quot; files found&quot
StoreResults = UBound(resultsarray, 1)
'Do whatever you want with the results here
Erase fldarray
Erase resultsarray
End Function

Good luck

Daniel Vlas
Systems Consultant
danvlas@yahoo.com

 

[dpimental]

OK, that looks good; but is there any way to limit it to a specific path, or can I pass the function the specific path that I want it to search?

David Please remember to give helpful posts the stars they deserve!
This makes the post more visible to others in need!

 

[danvlas]

get rid of the For j = 65 to 90...Next j loop and hardcode the path

Function StoreResults(FileName)
On Error Resume Next
Dim mypath, MyDirName, j, Dimension, myFileName, varreturn
Dim NoOfFiles As Long
ReDim fldarray(1, 0)
ReDim resultsarray(0)
DoCmd.Hourglass True

mypath = &quot;C:\Path\&quot;
1:
MyDirName = Dir(mypath, vbDirectory)
Do While MyDirName <> &quot;&quot;
NoOfFiles = NoOfFiles + 1
If MyDirName <> &quot;.&quot; And MyDirName <> &quot;..&quot; Then
If (GetAttr(mypath & MyDirName) And vbDirectory) = vbDirectory Then
Dimension = UBound(fldarray, 2) + 1
ReDim Preserve fldarray(1, Dimension)
fldarray(0, Dimension - 1) = 0
fldarray(1, Dimension - 1) = mypath & MyDirName & &quot;\&quot;
varreturn = SysCmd(acSysCmdSetStatus, mypath & MyDirName)
End If
End If
MyDirName = Dir
Loop
myFileName = Dir(mypath)
Do Until myFileName = &quot;&quot;
If InStr(myFileName, FileName) > 0 Then
Debug.Print myFileName
Dimension = UBound(resultsarray, 1) + 1
ReDim Preserve resultsarray(Dimension)
resultsarray(Dimension - 1) = mypath & myFileName
' the file is stored in resultsarray
End If
myFileName = Dir
varreturn = SysCmd(acSysCmdSetStatus, mypath & myFileName)
Loop
FileNotFound:
For Dimension = 0 To UBound(fldarray, 2) - 1
If fldarray(0, Dimension) = 0 Then
mypath = fldarray(1, Dimension)
fldarray(0, Dimension) = 1
GoTo 1
End If
Next Dimension
NextDrive:
varreturn = SysCmd(acSysCmdSetStatus, UBound(resultsarray, 1) & &quot; files found&quot
StoreResults = UBound(resultsarray, 1)
'Do whatever you want with the results here
Erase fldarray
Erase resultsarray
End Function

Good luck

Daniel Vlas
Systems Consultant
danvlas@yahoo.com

 

[dpimental]

When I run the code, it high-lights this section ...
ReDim fldarray(1, 0)

And says &quot;can't find project or library&quot;.

Any ideas?

David Please remember to give helpful posts the stars they deserve!
This makes the post more visible to others in need!

 

[dpimental]

I got it to work.

I changed the following.

I passed the &quot;path&quot; argument to the function.

And I added the following code to get the values passed to the array, and pushed the concatenated values to a msgbox .
I guess, I could have grabbed the values when they are pushed to the array.


Dim i As Integer, icount As Integer, temp As String
temp = &quot;&quot;

i = 0
icount = StoreResults - 1

For i = 0 To icount
temp = temp & resultsarray(i) & vbCrLf
Next i

'MsgBox resultsarray(1), vbOKOnly, &quot;array test&quot;
MsgBox temp, vbOKOnly, &quot;array test&quot;


David Please remember to give helpful posts the stars they deserve!
This makes the post more visible to others in need!