File Names

You can use the Dir function in VB recursively, to retrieve the names of all of the files in the Directory, and then by Opening a text file using either to VB Open and Write functions, or the FileSystemObject, you can write the names of the files to the output file.

The following routine should work:

Sub CreateDirectoryFile(ByVal sDir As String, ByVal sFileName As String)
   Dim hFile   As Integer
   Dim CurFile As String

   If Right(sDir,1)<>"\" Then sDir = sDir & "\"
   hFile = FreeFile()
   Open sFileName For Output As #hFile

   CurFile = Dir(sDir & "*.*")
   Do While Len(CurFile)
      Print #hFile, CurFile
      CurFile = Dir()
   Loop
   Close #hFile
End Sub


-Dennis Borg

Arthur - one of the weaknesses of the VB Dir function is that it cannot be called recursively. I would recommend the FileSystemObject method or the FindFile API calls.

If you wish to pursue the use of the VB Dir function then I answered a similar question last week on this which may be fund at

https://www.experts-exchange.com/jsp/qShow.jsp?qid=20158023

Regards
GK

Private Sub OutPutFiles(ByVal pstrPath As String)

  Dim objFile As File
  Dim objFolder As Folder
  Dim objFSO As FileSystemObject
 
  Set objFSO = New FileSystemObject
 
  Set objFolder = objFSO.GetFolder(pstrPath)

  Open App.Path & "Text.txt" For Output As #1
 
  For Each objFile In objFolder.Files
      Print #1, objFile.Name
  Next objFile

  Close #1
   
End Sub

Syntax  

OutPutFiles "c:\send"

Geoff, check the code that I posted.  I may not be calling Dir RECURSIVELY in the strict sense, bu that code does in fact return the names of ALL of the files (not folders) in the indicated folder).  Truem it does NOT traverse the included Folders within a given folder, but the original question did not ask for that.

If in fact, it is desired to traverse the ENTIRE tree strcuture within a given folder, then clearly the FSO is the only game in town.

>If in fact, it is desired to traverse the ENTIRE tree
>strcuture within a given folder, then clearly
>the FSO is the only game in town.

I would disagree with this concerning the FSO; I still wouldn't use it. I might use the Dir() function, but would probably use the Win API functions.

-Dennis Borg

this code contains a fully recursive file search function:

create a new form with

a DriveListBox   (drvDriveList)
a DirListBox     (dirFolderList)
a listview       (lstvwFatFiles)
a command button (cmdSearch)
a textbox        (txtFIleSize)

dont ask about the control names! - I've just ripped this code out of another project....


Option Explicit

Dim scrFileSys As Scripting.FileSystemObject
Private Sub drvDriveList_Change()
dirFolderList.Path = drvDriveList
End Sub

Private Sub Form_Load()
Set scrFileSys = New Scripting.FileSystemObject
dirFolderList.Path = Left(drvDriveList.Drive, 2) & "\"
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set scrFileSys = Nothing
End Sub

Private Sub cmdSearch_Click()
Dim fldStart As Scripting.Folder
Set fldStart = scrFileSys.GetFolder(dirFolderList.Path)
lstvwFatFiles.ListItems.Clear
FindFiles fldStart, txtFIleSize
End Sub

Private Sub FindFiles(fldSearch As Scripting.Folder, strFileName As String, Optional blnFindFolders As Boolean = True)
Dim fld As Scripting.Folder
Dim fyl As Scripting.File
Dim lngSize As Long
Dim itm As ListItem

    'Recursively Call this Function to Find Files in Sub Folders
    If fldSearch.SubFolders.Count Then
        For Each fld In fldSearch.SubFolders
            If blnFindFolders Then
                With fld
                    If InStr(.Name, strFileName) <> 0 Then
                        Set itm = lstvwFatFiles.ListItems.Add(Text:=.Name)
                        With itm
                            .SubItems(2) = fld.Type
                        End With
                    End If
                End With
            End If
            FindFiles fld, strFileName
        Next fld
    End If
   
    'Add matching files to list
    For Each fyl In fldSearch.Files
        With fyl
            If InStr(.Name, strFileName) <> 0 Then
                Set itm = lstvwFatFiles.ListItems.Add(Text:=.Name)
                lngSize = .Size / 1000
                With itm
                    .SubItems(1) = Format(lngSize, "#,###kB")
                    .SubItems(2) = fyl.Type
                End With
            End If
        End With
    Next fyl
   
    Set itm = Nothing
    Set fld = Nothing
End Sub

Hi

'====BAS module code=====
Option Explicit
Const MAX_PATH = 260
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_DIRECTORY = &H10

Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

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

Type FOLDER_INFO
   DirSize As Currency
   FilesCount As Long
   DirsCount As Long
End Type

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public sFiles() As String

Public Function GetFolderInfo(sFolder As String, Optional sPattern As String = "*.*") As FOLDER_INFO
   If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
   Dim lFileNum As Long, lDirNum As Long, sTemp As String
   Dim curSize As Currency, FolderQueue As New Collection
   FolderQueue.Add sFolder
   Call EnumFolder(FolderQueue)
   sTemp = FolderQueue.Item(1)
   Call EnumFiles(sTemp, lFileNum, curSize, sPattern)
   FolderQueue.Remove 1
   Do While FolderQueue.Count > 0
      lDirNum = lDirNum + 1
      Call EnumFolder(FolderQueue)
      sTemp = FolderQueue.Item(1)
      Call EnumFiles(sTemp, lFileNum, curSize, sPattern)
      FolderQueue.Remove 1
      DoEvents
   Loop
   GetFolderInfo.DirSize = curSize
   GetFolderInfo.FilesCount = lFileNum
   GetFolderInfo.DirsCount = lDirNum
End Function

Private Sub EnumFolder(FolderQueue As Collection)
   Dim sTemp As String, sFolder As String
   Dim lRet As Long, WFD As WIN32_FIND_DATA
   Dim hFile As Long
   sFolder = FolderQueue.Item(1)
   hFile = FindFirstFile(sFolder & "*.*", WFD)
   If hFile = INVALID_HANDLE_VALUE Then Exit Sub
   sTemp = TrimNulls(WFD.cFileName)
   Do While sTemp <> ""
      If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
         If sTemp <> "." And sTemp <> ".." Then
            If Right$(sTemp, 1) <> "\" Then sTemp = sTemp & "\"
            FolderQueue.Add sFolder & sTemp
         End If
      End If
      lRet = FindNextFile(hFile, WFD)
      sTemp = ""
      If lRet <> 0 Then sTemp = TrimNulls(WFD.cFileName)
   Loop
   lRet = FindClose(hFile)
End Sub

Private Sub EnumFiles(sFolder As String, lFileNum As Long, lngSize As Currency, sPattern As String)
   Dim sTemp As String
   Dim lRet As Long, WFD As WIN32_FIND_DATA
   Dim hFile As Long, n As Integer
   hFile = FindFirstFile(sFolder & sPattern, WFD)
   If hFile = INVALID_HANDLE_VALUE Then Exit Sub
   sTemp = TrimNulls(WFD.cFileName)
   Do While sTemp <> ""
      lngSize = lngSize + WFD.nFileSizeLow
      lFileNum = lFileNum + 1
      n = UBound(sFiles) + 1
      ReDim Preserve sFiles(n)
      sFiles(n) = sFolder & TrimNulls(WFD.cFileName)
      lRet = FindNextFile(hFile, WFD)
      sTemp = ""
      If lRet <> 0 Then sTemp = TrimNulls(WFD.cFileName)
   Loop
   lRet = FindClose(hFile)
End Sub

Private Function TrimNulls(sTemp As String) As String
   Dim l As Long
   l = InStr(1, sTemp, Chr(0))
   If l = 1 Then
      TrimNulls = ""
   ElseIf l > 0 Then
      TrimNulls = Left$(sTemp, l - 1)
   Else
      TrimNulls = sTemp
   End If
End Function

'=====Form code===
Private Sub Command1_Click()
   ReDim sFiles(0)
   Dim l As FOLDER_INFO
   l = GetFolderInfo("c:\windows\system", "*.exe")
   MsgBox "Total  " & l.DirSize & " bytes" & " in " & l.FilesCount & " files at " & l.DirsCount & " Folders"
   Open "c:\FileNames.txt" For Binary As #1
      Put #1,,sFiles
   Close #1
End Sub

Cheers

thank you...glad to help