Searching for files and storing the properties

I have been trying to write a multi looped function to do this job, but am having real trouble.

Basically, I want to search on a set directory, example c:\work
The start folder could have infinate subfolders.

I need to find all *.mdb files and record the properties in a table.

I have got most of the code in place, but am having trouble with the infinate sub folders bit.

Any help and examples would be great.

Thanks
Andy
LVL 1
andy_boothAsked:
Who is Participating?
 
Jim P.Commented:
The way I've pulled it off in the past is by doing the DOS command redirected to a file

DIR C:\Work\*.mdb /s > C:\TEMP\Dir_Output.txt

Then this module will parse the file:
------------------------------------------------------------
Public Function ImportDirListing()
Dim FileNum As Integer
Dim InputFile As String
Dim InputString As String

Dim I As Integer
Dim Skip As Boolean

Dim DB As Database
Dim RS As Recordset
Dim SQL As String

Dim PathName As String
Dim FileName As String
Dim FileDate As Date
Dim FileSize As Double
Dim FileType As String

SQL = "DELETE * FROM Dir_Listing_Tbl"
DoCmd.SetWarnings False
DoCmd.RunSQL SQL, True
DoCmd.SetWarnings True

Set DB = CurrentDb()
Set RS = DB.OpenRecordset("Dir_Listing_Tbl")

'Path_Name   File_Name   File_Date_Time  File_Size   Memo_Field
'Text        Text         Date/Time       Long        Text/Memo
FileNum = FreeFile()
InputFile = "C:\TEMP\Dir_Output.txt"
Open InputFile For Input Access Read Shared As #FileNum

PathName = ""

Do Until EOF(FileNum) = True 'I >= 50
    Line Input #FileNum, InputString
    Skip = False
    If Left(InputString, 16) = " Volume in drive" Then Skip = True
    If Left(InputString, 16) = " Volume Serial N" Then Skip = True
    If Left(InputString, 16) = "     Total Files" Then Skip = True
    If Right(InputString, 10) = "bytes free" Then Skip = True
   
    If Trim(InputString) = "" Then Skip = True
    If Mid(InputString, 18, 4) = "File" Then Skip = True
   
    If Left(InputString, 14) = " Directory of " Then
        PathName = Mid(InputString, 15, 253)
        Skip = True
    End If

   
    If Skip = False Then
   
        FileName = Trim(Mid(InputString, 40, 253))

       
        If Left(InputString, 14) <> " Directory of " Then
            FileDate = Left(InputString, 10) ' & " " & Trim(Mid(InputString, 13, 8))
        End If
        If Mid(InputString, 25, 5) = "<DIR>" Then
            FileType = "Dir"
            FileSize = 0
        Else
            FileType = "File"
            FileSize = (Replace(Trim(Mid(InputString, 22, 17)), ",", ""))
        End If
       
        'Debug.Print PathName & " " & FileName & " " & FileDate & " " & FileSize & " " & FileType
       
        With RS
            .AddNew
            !Path_Name = PathName
            !File_Name = FileName
            !File_Date_Time = FileDate
            !File_Size = FileSize
            !File_Type = FileType
            .Update
        End With
        'Field names in the table
        'Index_Num   Path_Name   File_Name   File_Date_Time  File_Size   File_Type
        'AutoNum     Text - 255  Text - 255  Date/Time       Double      Text - 20
    End If
   
Loop

Close #FileNum
Set RS = Nothing
Set DB = Nothing

End Function
0
 
jefftwilleyCommented:
Hi Andy,
you can try this..

http://www.mvps.org/access/api/api0006.htm
J
0
 
andy_boothAuthor Commented:
Thanks Guys.

jefftwilley, I had a look and could have probably picked out what I needed, but jimpen's solution was workable with a copy and paste, so I am giving him the points.

What would be really nice is to shell out, run the command, etc.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
Jim P.Commented:
You can actually do that --

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As Any, _
        ByVal lpWindowName As Any) As Long


Public Function Wait_For_Dir()

shell("DIR C:\Work\*.mdb /s > C:\TEMP\Dir_Output.txt")

sleep 5000

if FindWindow(vbNullString,"command prompt - dir ") <> 0 Then   '<-- you'll have play with the window name
     do until FindWindow(vbNullString,"command prompt - dir ") = 0  '<-- you'll have play with the window name
         sleep 5000
     loop
end if

call FindWindow(vbNullString,"command prompt - dir ") <> 0
end function
0
 
Jim P.Commented:
should be
------------------------------
end if

call ImportDirListing()
end function
------------------------------

Glad to be of assistance. May all your days get brighter and brighter.
0
 
andy_boothAuthor Commented:
Excellent, thanks Jimpen, I will have a play tomorrow, its home time :)
0
 
andy_boothAuthor Commented:
Well. I thought I would just chuck it in quickly before I go.

I get an error message.

Compile error:

Constants, fixed-length strings, arrays, user-defined types and Declare statements not allowed as Public members of object modules.

Here is the complete code. Maybe I entered something wrong?

Option Compare Database
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As Any, _
        ByVal lpWindowName As Any) As Long


Public Function Wait_For_Dir()

Shell ("DIR C:\Work\*.mdb /s > C:\TEMP\Dir_Output.txt")

Sleep 5000

If FindWindow(vbNullString, "command prompt - dir ") <> 0 Then  '<-- you'll have play with the window name
     Do Until FindWindow(vbNullString, "command prompt - dir ") = 0 '<-- you'll have play with the window name
         Sleep 5000
     Loop
End If

Call ImportDirListing
End Function


Public Function ImportDirListing()
Dim FileNum As Integer
Dim InputFile As String
Dim InputString As String

Dim I As Integer
Dim Skip As Boolean

Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim SQL As String

Dim PathName As String
Dim FileName As String
Dim FileDate As Date
Dim FileSize As Double
Dim FileType As String

SQL = "DELETE * FROM Dir_Listing_Tbl"
DoCmd.SetWarnings False
DoCmd.RunSQL SQL, True
DoCmd.SetWarnings True

Set DB = CurrentDb()
Set RS = DB.OpenRecordset("Dir_Listing_Tbl")

'Path_Name   File_Name   File_Date_Time  File_Size   Memo_Field
'Text        Text         Date/Time       Long        Text/Memo
FileNum = FreeFile()
InputFile = "C:\TEMP\Dir_Output.txt"
Open InputFile For Input Access Read Shared As #FileNum

PathName = ""

Do Until EOF(FileNum) = True 'I >= 50
    Line Input #FileNum, InputString
    Skip = False
    If Left(InputString, 16) = " Volume in drive" Then Skip = True
    If Left(InputString, 16) = " Volume Serial N" Then Skip = True
    If Left(InputString, 16) = "     Total Files" Then Skip = True
    If Right(InputString, 10) = "bytes free" Then Skip = True
   
    If Trim(InputString) = "" Then Skip = True
    If Mid(InputString, 18, 4) = "File" Then Skip = True
   
    If Left(InputString, 14) = " Directory of " Then
        PathName = Mid(InputString, 15, 253)
        Skip = True
    End If

   
    If Skip = False Then
   
        FileName = Trim(Mid(InputString, 40, 253))

       
        If Left(InputString, 14) <> " Directory of " Then
            FileDate = Left(InputString, 10) ' & " " & Trim(Mid(InputString, 13, 8))
        End If
        If Mid(InputString, 25, 5) = "<DIR>" Then
            FileType = "Dir"
            FileSize = 0
        Else
            FileType = "File"
            FileSize = (Replace(Trim(Mid(InputString, 22, 17)), ",", ""))
        End If
       
        'Debug.Print PathName & " " & FileName & " " & FileDate & " " & FileSize & " " & FileType
       
        With RS
            .AddNew
            !Path_Name = PathName
            !File_Name = FileName
            !File_Date_Time = FileDate
            !File_Size = FileSize
            !File_Type = FileType
            .Update
        End With
        'Field names in the table
        'Index_Num   Path_Name   File_Name   File_Date_Time  File_Size   File_Type
        'AutoNum     Text - 255  Text - 255  Date/Time       Double      Text - 20
    End If
   
Loop

Close #FileNum
Set RS = Nothing
Set DB = Nothing

End Function

Private Sub cmdGo_Click()
Call Wait_For_Dir
End Function
0
 
Jim P.Commented:
>> Constants, fixed-length strings, arrays, user-defined types and
>> Declare statements not allowed as Public members of object modules.

Is this in a standalone module or is it in a form or something like that?  If it is in a form you have to put it in a module.

ACC2000: How to Determine If a Specific Windows Program Is Running
http://support.microsoft.com/kb/210605/en-us
0
 
andy_boothAuthor Commented:
Hi Jimpen,

Sorry to keep posting in a closed question, but I have run into a problem.

The offending line is
FileSize = (Replace(Trim(Mid(InputString, 22, 17)), ",", ""))

The contents of Inputstring
03/05/2006  12:15           462,848 GeneralAverageFront.mdb

Can you give me a pointer as to where its going wrong?
0
 
Jim P.Commented:
? (Replace(Trim(Mid("03/05/2006  12:15           462,848 GeneralAverageFront.mdb", 22, 17)), ",", ""))
462848 Ge

The spacing on your DIR might be off from mine. The result is "462848 Ge" so its trying to put text in a numeric field.

Try it as
FileSize = (Replace(Trim(Mid(InputString, 22, 15)), ",", ""))
0
 
andy_boothAuthor Commented:
Actually, I just realised why.

?Mid(InputString, 22, 17)
       462,848 Ge

Would it be safe to reduce the mid size?
0
 
andy_boothAuthor Commented:
Well, it's working for the size field, but seems to be missing bits of the path and file name now.
0
 
andy_boothAuthor Commented:
Jimpen,

Here is an extract of the file created.

 Volume in drive E is New Volume
 Volume Serial Number is EC47-A400

 Directory of e:\central3\Apps

01/06/2006  09:39           288,768 GAFront.mdb
03/05/2006  12:15           462,848 GeneralAverageFront.mdb
13/10/2004  09:06           579,584 GeneralAveragePRO991223_1100.mdb
13/10/2004  09:06           784,384 GeneralAveragePROdata991213_1800.mdb
03/05/2006  10:31           579,584 NewGeneralAveragePRO991223_1100.mdb
               5 File(s)      2,695,168 bytes

 Directory of e:\central3\Apps\ABT\BIN

22/06/1998  08:25            94,208 PRRPTDL.MDB
               1 File(s)         94,208 bytes

 Directory of e:\central3\Apps\ABT\DOWNLOAD

24/06/1998  13:38            88,064 TARGET.MDB
               1 File(s)         88,064 bytes

 Directory of e:\central3\Apps\ACCESS\SAMPAPPS

05/04/1994  01:00         1,802,240 NWIND.MDB
05/04/1994  01:00           229,376 ORDERS.MDB
05/04/1994  01:00           458,752 SOLUTION.MDB
               3 File(s)      2,490,368 bytes

 Directory of e:\central3\Apps\AMS\AMSDATA

28/02/2000  13:38           262,144 ams.mdb
               1 File(s)        262,144 bytes

 Directory of e:\central3\Apps\AMS\LOGDATA\86METERS\ELEC_TO2

12/12/1997  15:17         1,523,712 DB1.MDB
               1 File(s)      1,523,712 bytes

 Directory of e:\central3\Apps\APPORT

13/07/1999  16:08       146,472,960 Shares.mdb
               1 File(s)    146,472,960 bytes

 Directory of e:\central3\Apps\bankline\COMET

17/12/1998  18:20           425,984 Comet.mdb
               1 File(s)        425,984 bytes
0
 
Jim P.Commented:
0
 
Jim P.Commented:
Public Function ImportDirListing()
Dim FileNum As Integer
Dim InputFile As String
Dim InputString As String

Dim I As Integer
Dim Skip As Boolean

Dim DB As Database
Dim RS As Recordset
Dim SQL As String

Dim PathName As String
Dim FileName As String
Dim FileDate As Date
Dim FileSize As Double
Dim FileType As String

SQL = "DELETE * FROM Dir_Listing_Tbl"
DoCmd.SetWarnings False
DoCmd.RunSQL SQL, True
DoCmd.SetWarnings True

Set DB = CurrentDb()
Set RS = DB.OpenRecordset("Dir_Listing_Tbl")

'Path_Name   File_Name   File_Date_Time  File_Size   Memo_Field
'Text        Text         Date/Time       Long        Text/Memo
FileNum = FreeFile()
InputFile = "c:\temp\AccessMDB_Output_d.txt"
Open InputFile For Input Access Read Shared As #FileNum

PathName = ""

Do Until EOF(FileNum) = True 'I >= 50
    Line Input #FileNum, InputString
    Skip = False
    If Left(InputString, 16) = " Volume in drive" Then Skip = True
    If Left(InputString, 16) = " Volume Serial N" Then Skip = True
    If Left(InputString, 16) = "     Total Files" Then Skip = True
    If Right(InputString, 10) = "bytes free" Then Skip = True
   
    If Trim(InputString) = "" Then Skip = True
    If Mid(InputString, 18, 4) = "File" Then Skip = True
   
    If Left(InputString, 14) = " Directory of " Then
        PathName = Mid(InputString, 15, 253)
        Skip = True
    End If

   
    If Skip = False Then
   
        FileName = Trim(Mid(InputString, 37, 253))

       
        If Left(InputString, 14) <> " Directory of " Then
            FileDate = Replace(Left(InputString, 18), "  ", " ") ' & " " & Trim(Mid(InputString, 13, 8))
        End If
        If Mid(InputString, 25, 5) = "<DIR>" Then
            FileType = "Dir"
            FileSize = 0
        Else
            FileType = "File"
            FileSize = (Replace(Trim(Mid(InputString, 22, 15)), ",", ""))
        End If
       
        'Debug.Print PathName & " " & FileName & " " & FileDate & " " & FileSize & " " & FileType
       
        With RS
            .AddNew
            !Path_Name = PathName
            !File_Name = FileName
            !File_Date_Time = FileDate
            !File_Size = FileSize
            !File_Type = FileType
            .Update
        End With
        'Field names in the table
        'Index_Num   Path_Name   File_Name   File_Date_Time  File_Size   File_Type
        'AutoNum     Text - 255  Text - 255  Date/Time       Double      Text - 20
    End If
   
Loop

Close #FileNum
Set RS = Nothing
Set DB = Nothing

End Function
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.