?
Solved

Searching for files and storing the properties

Posted on 2006-06-07
17
Medium Priority
?
326 Views
Last Modified: 2012-06-27
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
0
Comment
Question by:andy_booth
  • 8
  • 7
16 Comments
 
LVL 34

Expert Comment

by:jefftwilley
ID: 16852861
Hi Andy,
you can try this..

http://www.mvps.org/access/api/api0006.htm
J
0
 
LVL 38

Accepted Solution

by:
Jim P. earned 500 total points
ID: 16852917
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
 
LVL 1

Author Comment

by:andy_booth
ID: 16853232
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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 38

Expert Comment

by:Jim P.
ID: 16853482
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
 
LVL 38

Expert Comment

by:Jim P.
ID: 16853511
should be
------------------------------
end if

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

Glad to be of assistance. May all your days get brighter and brighter.
0
 
LVL 1

Author Comment

by:andy_booth
ID: 16853654
Excellent, thanks Jimpen, I will have a play tomorrow, its home time :)
0
 
LVL 1

Author Comment

by:andy_booth
ID: 16853710
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
 
LVL 38

Expert Comment

by:Jim P.
ID: 16853834
>> 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
 
LVL 1

Author Comment

by:andy_booth
ID: 16860669
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
 
LVL 38

Expert Comment

by:Jim P.
ID: 16860704
? (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
 
LVL 1

Author Comment

by:andy_booth
ID: 16860711
Actually, I just realised why.

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

Would it be safe to reduce the mid size?
0
 
LVL 1

Author Comment

by:andy_booth
ID: 16860904
Well, it's working for the size field, but seems to be missing bits of the path and file name now.
0
 
LVL 1

Author Comment

by:andy_booth
ID: 16860916
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
 
LVL 38

Expert Comment

by:Jim P.
ID: 16860997
0
 
LVL 1

Author Comment

by:andy_booth
ID: 16861041
0
 
LVL 38

Expert Comment

by:Jim P.
ID: 16861235
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

Featured Post

Granular recovery for Microsoft Exchange

With Veeam Explorer for Microsoft Exchange you can choose the Exchange Servers and restore points you’re interested in, and Veeam Explorer will present the contents of those mailbox stores for browsing, searching and exporting.

Question has a verified solution.

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

Instead of error trapping or hard-coding for non-updateable fields when using QODBC, let VBA automatically disable them when forms open. This way, users can view but not change the data. Part 1 explained how to use schema tables to do this. Part 2 h…
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…

850 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