?
Solved

scanning Files On C Drive

Posted on 2003-03-24
6
Medium Priority
?
154 Views
Last Modified: 2010-04-07
hi There,

I need to scan drive C and store my files location in a DB. (something like dir /s)
but i can't run the dir function 2 times together, i'm getting an error.


Private Sub Form_Load()

Dim A As String
Dim B As String

A = Dir("C:\2\", vbDirectory)
Do While A <> ""

If A <> "." And A <> ".." Then

    B = Dir("C:\2\" & A, vbDirectory)
       
        Do While B <> ""
        If B <> "." And B <> ".." Then
 
            MsgBox B
               
        End If
        B = Dir()   ' Get next entry.
    Loop
   
End If
A = Dir()
Loop

End Sub

After scanning the location of B and return to "A = Dir()" I'm geting the error.

What can I do ? I need to scan all the way down to the lowest directory, get the file's name and go up one level to next directory.

Dir() function can't handel it.

Any alternative ?

Nir.


0
Comment
Question by:computech1
[X]
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
6 Comments
 
LVL 5

Expert Comment

by:Cimperiali
ID: 8195729
Do you want to use Dir?
Then Balena did it this way (else, you could use FileSystemObject):
GetAllFiles - Search files in a directory or directory tree
Date: 11/18/2000
Versions: VB6 VBS Level: Intermediate
Author: The VB2TheMax Team

' Returns a collection with the names of all the files
' that match a file specification
'
' The file specification can include wildcards; multiple
' specifications can be provided, using a semicolon-delimited
' list, as in "*.tmp;*.bat"
' If RECURSEDIR is True the search is extended to all subdirectories
'
' It raises no error if path is invalid
'

Function GetAllFiles(ByVal path As String, ByVal filespec As String, _
    Optional RecurseDirs As Boolean) As Collection
    Dim spec As Variant
    Dim file As Variant
    Dim subdir As Variant
    Dim subdirs As New Collection
    Dim specs() As String
   
    ' initialize the result
    Set GetAllFiles = New Collection
   
    ' ensure that path has a trailing backslash
    If Right$(path, 1) <> "\" Then path = path & "\"
   
    ' get the list of provided file specifications
    specs() = Split(filespec, ";")
   
    ' this is necessary to ignore duplicates in result
    ' caused by overlapping file specifications
    On Error Resume Next
               
    ' at each iteration search for a different filespec
    For Each spec In specs
        ' start the search
        file = Dir$(path & spec)
        Do While Len(file)
            ' we've found a new file
            file = path & file
            GetAllFiles.Add file, file
            ' get ready for the next iteration
            file = Dir$
        Loop
    Next
   
    ' first, build the list of subdirectories to be searched
    If RecurseDirs Then
        ' get the collection of subdirectories
        ' start the search
        file = Dir$(path & "*.*", vbDirectory)
        Do While Len(file)
            ' we've found a new directory
            If file = "." Or file = ".." Then
                ' exclude the "." and ".." entries
            ElseIf (GetAttr(path & file) And vbDirectory) = 0 Then
                ' ignore regular files
            Else
                ' this is a directory, include the path in the collection
                file = path & file
                subdirs.Add file, file
            End If
            ' get next directory
            file = Dir$
        Loop
       
        ' parse each subdirectory
        For Each subdir In subdirs
            ' use GetAllFiles recursively
            For Each file In GetAllFiles(subdir, filespec, True)
                GetAllFiles.Add file, file
            Next
        Next
    End If
   
End Function

 
0
 
LVL 9

Expert Comment

by:GivenRandy
ID: 8195769
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 8196832
>scan drive C and store my files location in a DB. (something like dir /s)
Why not just use the dir/s ? :

shell(environ("comspec") & " /c dir c: /s /b > c:\AllFiles.txt")

then when done, just open the file ("c:\AllFiles.txt") and move each line into the database as needed.

0
Technology Partners: 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!

 

Author Comment

by:computech1
ID: 8201796
Cimperiali's code is great but with one problem.

collection object can store only 256 items, I need to scan a full drive (much more then 256 files .... )

Nir.

0
 
LVL 5

Accepted Solution

by:
Cimperiali earned 200 total points
ID: 8201866
Then you can use filesystem object...
Private Sub CmdSearch_Click()
Dim theFolder As Scripting.Folder
Screen.MousePointer = vbHourglass
'use filesystem object:
be sure you reference the "Scripting runtime" libraries
'(menu->project->references-> "Microsoft Scripting runtime"
Private Fso As Scripting.FileSystemObject
Dim theAttributes As Integer
Dim blnStop As Boolean
Const IamLooking As String = "Currently looking: "
'A comandbutton to stop search
Private Sub CmdStop_Click()
  blnStop = True
End Sub

'A commandButton to start search
Private Sub CmdSearch_Click()
blnStop = False
List1.Clear
Set Fso = New Scripting.FileSystemObject

Set theFolder = Fso.GetFolder("C:\")
Call searchFiles(theFolder)
'free resources
Set Fso = Nothing
'a label to display info
lblInfo.Caption = IamLooking
Screen.MousePointer = vbDefault
End Sub
'Search files and add them to a listBox
Private Sub searchFiles(theFolder As Scripting.Folder)
 On error resume next 'there are some floders and files you cannot heven search for...
 'list all files
 Dim theFile As Scripting.File
 
 For Each theFile In theFolder.Files
   if err.number=0 then
      lblInfo.Caption = IamLooking & theFile.Path
      DoEvents 'To avoid program hang
      If blnStop Then Exit Sub
      'add this one
      List1.AddItem theFile.Name & " in: " & theFile.Path
    else
       'do nothing, but try with next file
       err.clear
    end if
 Next
 'search in subfolders
 Dim theSubfolder As Scripting.Folder
 For Each theSubfolder In theFolder.SubFolders
   If blnStop Then Exit Sub
   'recursive call
   if err.number=0 then
      Call searchFiles(theSubfolder)
   else
      'Do nothing but try with next folder
      err.clear
   end if
 Next
 'not need to set objects to nothing....!
End Sub
0
 

Author Comment

by:computech1
ID: 8209556
Great Code !! thanks.
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

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

Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28455246.html)28455246) Here (http…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses
Course of the Month10 days, 7 hours left to enroll

765 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