Nested Dir loops

[jaybee3]

As I have just found out I don't think it's possible to nest Dir loops. Current code:

    sFile_1= Dir(sPath_Internal & "*.xls") 
    While sFile_1<> ""
       ...
       sFile_2= Dir(sFile_1_variable & "*.xls")
       While sFile_2<> ""
       ...
       sFile_2= Dir
    sFile_1= Dir

Is there a for each for folders for example or should I store the results of Dir in an array and just go through it that way? Or I'm open to any other suggestions you might have too. Cheers in advance

 

[mjbeam]

I would recommend using the filesystem object and creating a recursive function. Here is an example:

Private Const vbDot = 46
         
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const MAX_PATH As Long = 260
Private Const FILE_ATTRIBUTE_READONLY As Long = &H1
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Private Const FILE_ATTRIBUTE_SYSTEM As Long = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800
Private Const FILE_ATTRIBUTE_ALL As Long = FILE_ATTRIBUTE_READONLY Or _
                                           FILE_ATTRIBUTE_HIDDEN Or _
                                           FILE_ATTRIBUTE_SYSTEM Or _
                                           FILE_ATTRIBUTE_ARCHIVE Or _
                                           FILE_ATTRIBUTE_NORMAL Or _
                                           FILE_ATTRIBUTE_COMPRESSED
Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Public Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Long
End Type

Private Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Private Declare Function FindClose Lib "kernel32" _
  (ByVal hFindFile As Long) As Long
   
Private Declare Function FindFirstFile Lib "kernel32" _
   Alias "FindFirstFileA" _
  (ByVal lpFileName As String, _
   lpFindFileData As WIN32_FIND_DATA) As Long
   
Private Declare Function FindNextFile Lib "kernel32" _
   Alias "FindNextFileA" _
  (ByVal hFindFile As Long, _
   lpFindFileData As WIN32_FIND_DATA) As Long
   
Private Declare Function GetFileAttributes Lib "kernel32" _
   Alias "GetFileAttributesA" _
  (ByVal lpFileName As String) As Long

Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long
  
Private Declare Function FileTimeToSystemTime Lib "kernel32" _
    (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long

Private Declare Function FileTimeToLocalFileTime Lib "kernel32" _
    (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long

Private Sub Index_Drive()

    Dim sdpath As String
    
    GetDirectoryContents ThisWorkbook.Path & "\"
    
    Application.StatusBar = False

End Sub

Private Sub GetDirectoryContents(ByVal ssource As String)

   Dim wfd As WIN32_FIND_DATA
   Dim hFile As Long
   Dim fCount As Long
   Dim t_attrib As Long
   Dim tstatus As Long
   Dim tsource As String
   
   hFile = FindFirstFile(ssource & "*.*", wfd)
   
   If hFile <> INVALID_HANDLE_VALUE Then
   
      Do
      
        t_attrib = GetFileAttributes(ssource & wfd.cFileName)
      
        If Left(wfd.cFileName, 1) <> "." Then
        
          'Is it a directory?
          If (FILE_ATTRIBUTE_DIRECTORY And t_attrib) And _
              (Asc(wfd.cFileName) <> vbDot) Then
              
              tsource = Left(wfd.cFileName, InStr(wfd.cFileName, Chr(0)) - 1) & "\"
              
              Application.StatusBar = "Scanning " & ssource & tsource
              GetDirectoryContents ssource & tsource
          
          ElseIf (FILE_ATTRIBUTE_ALL And t_attrib) And _
              (Asc(wfd.cFileName) <> vbDot) Then
              
              temp = ""
              t = wfd.cFileName
              i = 1
              Do
                If Asc(Mid(t, i, 1)) <> 0 Then temp = temp & Mid(t, i, 1)
                i = i + 1
              Loop Until Asc(Mid(t, i, 1)) = 0
              
              tPath = ssource & temp
              
              i = 1
              Do
                i = i + 1
              Loop Until Cells(i, 1) = ""
              
              Cells(i, 1) = tPath
                            
          End If
                     
        End If
                     
        tstatus = FindNextFile(hFile, wfd)
        
        DoEvents
        
      Loop Until tstatus = 0
      
   End If
   
    'Close the search handle
    Call FindClose(hFile)

End Sub

Execute the subroutine Index_Drive.

 

[vaskov17]

Sub ListFiles()
    Dim objFSO As Object
    Dim objFolder As Object
    
    Set objFSO = CreateObject("scripting.filesystemobject")
    
    Set objFolder = objFSO.GetFolder("c:\") 'change the path to whatever you want
    
    ParseFolder objFolder
End Sub

Sub ParseFolder(objFolder As Object)
    Dim objFile As Object
    
    For Each objFile In objFolder.Files
        
        
        'DO STUFF TO EACH FILE
        
        
    Next
    
    'parse all subfolders
    For Each objFolder In objFolder.SubFolders
        ParseFolder objFolder
    Next
End Sub