read dir and files

[matrixindicator]

I need to feed a combobox list with not only the files (easy) but the complete url. A fixes part "D:\CTRL\ES\" and a variable part directory after this like "D:\CTRL\ES\01_09", "D:\CTRL\ES\02_09", "D:\CTRL\ES\03_09"
This works until I use a Dir to get MyFile = MyLinkToFile & Dir(MyLinkToFile & "*.*").
He represent nice the first url "D:\CTRL\ES\01_09\excel.xls" but can't go to the next map 02_09 via MyName = Dir ' Get next entry.

' Display the names in D:\ that represent directories.
MyPath = "D:\CTRL\ES\"    ' Set the path.
MyName = Dir(MyPath, vbDirectory)    ' Retrieve the first entry.
Do While MyName <> ""    ' Start the loop.
    ' Ignore the current directory and the encompassing directory.
    If MyName <> "." And MyName <> ".." Then
        ' Use bitwise comparison to make sure MyName is a directory.
        If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
             MyLinkToFile = MyPath & MyName & "\"
             MyFile = MyLinkToFile & Dir(MyLinkToFile & "*.*")
             'ComboBox1.AddItem (MyLinkToFile & Dir(MyLinkToFile & "*.*"))
             ' Display entry only if it
        End If    ' it represents a directory.
    End If
    MyName = Dir ' Get next entry.
Loop

Finally I should get combobox values like

"D:\CTRL\ES\01_09\excel.xls"
"D:\CTRL\ES\02_09\excel.xls"
"D:\CTRL\ES\03_09\excel.xls"

 

[PHV]

Have a look here:

http://msdn2.microsoft.com/en-us/library/z9ty6h50.aspx

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[vb5prgrmr]

Okay, this might be a little bit of overkill for what you need but it will definitly do what you want it to do. This is from a VB6 module I redid/revamped here in VB6 not to long ago.

'********************************************
'Author       :Michael P. Morrissey
'Contact Info :vb5prgrmr@mail.com or vb5prgrmr@yahoo.com
'Creation Date:20090120
'Notes        :Actually some time in the past but these various methods have now been
'             :incorporated into this one demo project
'********************************************
Option Explicit

'for printing purposes when font in design environment is size 10, margins are .5", and paper is set to landscape
'1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678

'for printing purposes when font in design environment is size 10 and margins are .5"
'1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678

'********************************************
'Author       :Michael P. Morrissey
'Creation Date:20090120
'Proceedure   :modDirSearchFoldersFiles
'Arguments    :ByVal InitialPath As String, Optional ByVal SearchPattern As String,
'             :Optional SearchSubDirectories As Boolean = True,
'             :Optional SearchAttribute As Integer = vbNormal + vbReadOnly + vbHidden + vbSystem + vbDirectory (23),
'             :Optional SearchForFolders As Boolean = False,
'             :Optional SearchForFiles As Boolean = True,
'             :Optional SearchForOnlyFiles As Boolean = False,
'Returns      :
'Description  :See in code comments
'********************************************
Public Sub modDirSearchFoldersFiles(ByVal InitialPath As String, Optional ByVal SearchPattern As String = "*.*", _
                                    Optional SearchAttributes As Integer = vbNormal + vbReadOnly + vbHidden + vbSystem + vbDirectory, _
                                    Optional SearchSubDirectories As Boolean = True, _
                                    Optional SearchForOnlyFolders As Boolean = False, _
                                    Optional SearchForOnlyFiles As Boolean = False)

On Error GoTo modDirSearchFoldersFilesError

'this sub uses the Dir Function to search for files and/or folders from an initial path
'it also uses recursion to complete the search if necessary
'First declare procedural level variables
Dim ReturnString As String, EmptyDirectory As Boolean
Dim SubDirectories As New Collection, CollectionLoopCounter As Integer

'the EmptyDirectory variable is set here because as a programmer who loves to download
'tons of various stuff(crap) just to see what is under the hood(code), I tend to move
'stuff around and delete those examples that do not work as advertised and each month
'I used to have to go through and remove all those empty directories but because I put
'this here and call the sub that says I have an empty directory, I just need to delete
'the empty directory. Another reason is, I don't want to make db entries for every
'directory/sub directory unless there is a file (in conjunction with a MD5 example I
'have done to make sure that the files I have are unique)
EmptyDirectory = True

'then because of the way I have set up the optional arguements we need to check to see
'if we have been passed non search terms
If SearchForOnlyFolders = True And SearchForOnlyFiles = True Then
  
  'if we are here then the user has passed us conflicting arguements and if this was in
  'a class module this is where we would raise an error event but because this is in
  'a module we will just call another sub and pass our error number and description
  'to it. then we will exit this sub
  ReturnString = "You have set both search for only folders and search for only files"
  ReturnString = ReturnString & " flags to true. These flags conflict with one another"
  ReturnString = ReturnString & " leaving nothing to search for."
  Call CustomErrorCall(1, ReturnString, "Please reset one of these flags to false and try your search again.")
  Exit Sub
  
End If

'check to make sure that we have a properly formatted path
If Right(InitialPath, 1) <> "\" Then InitialPath = InitialPath & "\"

'if this were a class we would raise and event so the user/end programmer could notify
'the end user of where we are currently searching. This is probably not needed in
'single directory searches but if we are searching sub directories then this does come
'in quite handy
Call SearchLocationEvent(InitialPath)

'retrieve the first directory or file
ReturnString = Dir(InitialPath & SearchPattern, SearchAttributes)

'now loop through the contents of this directory
Do While ReturnString <> ""
  
  'Ignore the current directory and the encompassing directory.
  If ReturnString <> "." And ReturnString <> ".." Then
    
    'okay, not an empty directory so set indicating variable
    EmptyDirectory = False
    
    'Use bitwise comparison to make sure ReturnString is a directory.
    If (GetAttr(InitialPath & ReturnString) And vbDirectory) = vbDirectory Then
      
      'found an error that could not be handled when it comes to .sys files, hence the
      'resume next in the error handler but because we resume next we end up here
      'so we need to check for the .sys files
      If LCase(Right(ReturnString, 4)) = LCase(".sys") Then
        
        'okay, if we are here then the .sys file has met the search criteria and if this
        'was a class module we would raise an event here for the end programmer to
        'handle but since we are in a module we will call a sub but first we need to
        'check to see if we are to search for files or only folders
        If SearchForOnlyFolders = False Then
          
          'if we are here then we are searching for both files and folders or files only
          'so call our FoundFileEvent and pass the relavent information
          Call FoundFileEvent(InitialPath, ReturnString)
          
        End If
        
      Else 'If LCase(Right(ReturnString, 4)) = LCase(".sys") Then
        
        'if we are here then we have found a directory and now we need to check to see
        'if we are searching for only files
        If SearchForOnlyFiles = False Then
          
          'so either we are searching for both files and folders or we are searching
          'for just folders. Either way we now need to raise an event and once again
          'since we are in a module we will just call a sub to handle this for us
          Call FoundFolderEvent(InitialPath, ReturnString)
          
        End If
        
        'ok, now check to see if we are to search sub directories
        If SearchSubDirectories = True Then
          
          'if we are here then we are to search sub directories, so add this
          'subdirectory to our collection for use later in our recursion
          SubDirectories.Add InitialPath & ReturnString & "\"
          
        End If
        
      End If 'If LCase(Right(ReturnString, 4)) = LCase(".sys") Then
      
    Else 'If (GetAttr(InitialPath & ReturnString) And vbDirectory) = vbDirectory Then
      
      'if we are here then the object found is not a directory
      Call FoundFileEvent(InitialPath, ReturnString)
      
    End If 'If (GetAttr(InitialPath & ReturnString) And vbDirectory) = vbDirectory Then
    
  End If 'If ReturnString <> "." And ReturnString <> ".." Then
  
  'this loop will eat up as much system resources as it can, and in doing so it will
  'make this program become unresponsive or seem frozen to the end user. So to prevent
  'this we do
  DoEvents
  
  'Get next entry.
  ReturnString = Dir
  
Loop 'Do While ReturnString <> ""

'check to see if we have found a subdirectory or file in this directory
If EmptyDirectory = True Then
  
  'this directory is empty so lets call a sub (if class raise event)
  Call FoundEmptyFolderEvent(InitialPath)
  
End If

'ok, now check to see if we are to search sub directories
If SearchSubDirectories = True Then
  
  'okay, we are to search subdirectories so now we need to loop through our collection
  'and call ourselves recursivly to search those sub directories
  For CollectionLoopCounter = 1 To SubDirectories.Count
    
    'so now it is time for our recursive call
    Call modDirSearchFoldersFiles(SubDirectories.Item(CollectionLoopCounter), _
        SearchPattern, SearchAttributes, SearchSubDirectories, _
        SearchForOnlyFolders, SearchForOnlyFiles)
    
  Next CollectionLoopCounter
  
End If

DoEvents

Exit Sub
modDirSearchFoldersFilesError:

'some system files don't like to be found
If Err.Number = 5 Or Err.Number = 52 Then
  
  'I have found that when you find .sys files this is the only way to continue on
  'I have tried err.clear with a goto that would take the code to bottom of the loop
  'right above the ReturnString = Dir but that did not work
  Resume Next
  
End If

MsgBox Err.Number & " " & Err.Description

End Sub

'********************************************
'Author       :Michael P. Morrissey
'Creation Date:20090120
'Proceedure   :SearchLocationEvent
'Arguments    :ByVal PathToWhereWeAreCurrentlySearching As String
'Returns      :
'Description  :See in code comments
'********************************************
Private Sub SearchLocationEvent(ByVal PathToWhereWeAreCurrentlySearching As String)

On Error GoTo SearchLocationEventError

'Note for the end programmer: You can modify this as necessary under the terms of the
'license agreement

'WARNING: do not do any file operations here or call any procedure that does file operations or
'the recursive dir search will loose where it is at and will end prematurly

'this sub is called each time the modDirSearchFoldersFiles sub is called because the
'modDirSearchFoldersFiles uses recursion to search sub folders so this sub is used
'to notify the end user of where we are currently searching.

'for debugging purposes
Debug.Print "Search Location = " & PathToWhereWeAreCurrentlySearching

Exit Sub
SearchLocationEventError:

MsgBox Err.Number & " " & Err.Description

End Sub

'********************************************
'Author       :Michael P. Morrissey
'Creation Date:20090120
'Proceedure   :CustomErrorCall
'Arguments    :ErrorNumber As Long, ErrorMessage As String, Optional CorrectiveAction As String
'Returns      :
'Description  :See in code comments
'********************************************
Private Sub CustomErrorCall(ErrorNumber As Long, ErrorMessage As String, _
                            Optional CorrectiveAction As String = "")

On Error GoTo CustomErrorCallError

'Note for the end programmer: You can modify this as necessary under the terms of the
'license agreement

'for now though here is an example
Dim Msg As String

'lets build and format our error message
Msg = "Error Number = " & Str(ErrorNumber) & vbNewLine
Msg = Msg & "Error Descripton = " & ErrorMessage & vbNewLine & vbNewLine

'now lets check to see if there is any corrective action that can be added to the message
If Trim(CorrectiveAction) <> "" Then
  
  'add the corrective action string to our message
  Msg = Msg & "Corrective Action = " & CorrectiveAction
  
End If

'now notify either end user or end programmer of what has happened
MsgBox Msg, vbOKOnly + vbCritical, "Custom Error"

Exit Sub
CustomErrorCallError:

MsgBox Err.Number & " " & Err.Description

End Sub

'********************************************
'Author       :Michael P. Morrissey
'Creation Date:20090120
'Proceedure   :FoundFileEvent
'Arguments    :ByVal PathWhereFileFound As String, ByVal NameOfFileFound As String
'Returns      :
'Description  :See in code comments
'********************************************
Private Sub FoundFileEvent(ByVal PathWhereFileFound As String, ByVal NameOfFileFound As String)

On Error GoTo FoundFileEventError

'Note for the end programmer: You can modify this as necessary under the terms of the
'license agreement

'WARNING: do not do any file operations here or call any procedure that does file operations or
'the recursive dir search will loose where it is at and will end prematurly

'when a file is found, this sub is called so the end user/programmer can add the found
'file to their list/collection/dictionary or call their sub/function that will handle
'this information in the way they want

'for debugging purposes
Debug.Print "File = " & NameOfFileFound

Exit Sub
FoundFileEventError:

MsgBox Err.Number & " " & Err.Description

End Sub

'********************************************
'Author       :Michael P. Morrissey
'Creation Date:20090120
'Proceedure   :FoundFolderEvent
'Arguments    :ByVal PathWhereFolderFound As String, ByVal NameOfFolderFound As String
'Returns      :
'Description  :See in code comments
'********************************************
Private Sub FoundFolderEvent(ByVal PathWhereFolderFound As String, ByVal NameOfFolderFound As String)

On Error GoTo FoundFolderEventError

'Note for the end programmer: You can modify this as necessary under the terms of the
'license agreement

'WARNING: do not do any file operations here or call any procedure that does file operations or
'the recursive dir search will loose where it is at and will end prematurly

'when a Folder is found, this sub is called so the end user/programmer can add the found
'Folder to their list/collection/dictionary or call their sub/function that will handle
'this information in the way they want

'for debugging purposes
Debug.Print "Folder = " & NameOfFolderFound

Exit Sub
FoundFolderEventError:

MsgBox Err.Number & " " & Err.Description

End Sub

'********************************************
'Author       :Michael P. Morrissey
'Creation Date:20090120
'Proceedure   :FoundEmptyFolderEvent
'Arguments    :ByVal FullPathToEmptyFolder As String
'Returns      :
'Description  :See in code comments
'********************************************
Private Sub FoundEmptyFolderEvent(ByVal FullPathToEmptyFolder As String)

On Error GoTo FoundEmptyFolderEventError

'Note for the end programmer: You can modify this as necessary under the terms of the
'license agreement

'WARNING: do not do any file operations here or call any procedure that does file operations or
'the recursive dir search will loose where it is at and will end prematurly

'when a Folder is found, this sub is called so the end user/programmer can add the found
'Folder to their list/collection/dictionary or call their sub/function that will handle
'this information in the way they want

'for debugging
Debug.Print "Empty Directory = " & FullPathToEmptyFolder

Exit Sub
FoundEmptyFolderEventError:

MsgBox Err.Number & " " & Err.Description

End Sub

and you would call it simply like this...
[tt]
modDirSearchFoldersFiles "D:\CTRL\ES\"
[/tt]
but to add items (files) found to your combo box, use the sub
[tt]
FoundFileEvent
[/tt]
and comment out all the subs debug.print lines

Hope this helps, Good Luck