CODEWITHSUNDEEP
vbaloopsdirectoryvb6
dextermikles
dextermikles

Reputation: 107

How to get list of all subfolders in one folder and write it to txt file using vb

I want to know, how it possible to get list of all subfolders in "C/Windows" and write it to txt file. Here is my code:

Sub Check
MkDir "c:\New_Folder"

Dim iFileNo as Integer
Dim strFile As String
  strFile = "c:\New_Folder\data.txt" 'the file you want to save to
  intFile = FreeFile
  Open strFile For Output As #intFile
    Print #intFile, 
  Close #intFile

End Sub

Full Explanation: Write a program, like opening a folder on the D drive (the folder is your nickname). In this folder open the file data.txt, in which write down the names of all folders from the directory C: \ Windows. 2. Write a program that reads information from a file, which was opened with a first program and transfer through MsgBox skin another row to the file

Upvotes: 1

Views: 1763

Answers (3)

FaneDuru
FaneDuru

Reputation: 42256

Please, try the next code:

Sub testGetSubFolders()
  Dim strFold As String, strFile As String, arrTxt
  strFold = "C:\Windows"
  If dir("c:\New_Folder", vbDirectory) = "" Then 'if the folder does not exist
     MkDir "c:\New_Folder"                       'it is created
  End If
  strFile = "c:\New_Folder\data.txt"
  arrTxt = GetSubFolders(strFold)     'receive an array of subfolders

  Open strFile For Output As #1
      Print #1, Join(arrTxt, vbCrLf) 'join the array on end of line
    Close #1
End Sub

Function GetSubFolders(strFold As String) As Variant 'it returns an array of subfolders path
   Dim fso, fldr, subFldr, arr, i As Long
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set fldr = fso.GetFolder(strFold)
   ReDim arr(fldr.subFolders.count - 1)   'redim the array to keep the paths
     For Each subFldr In fldr.subFolders
         arr(i) = subFldr.Path: i = i + 1 'place the paths in the array and increment i
     Next subFldr
  GetSubFolders = arr
End Function

Upvotes: 0

Brian M Stafford
Brian M Stafford

Reputation: 8868

Whenever a problem is defined as "get list of all subfolders" and "write to a text file", I know I likely need to implement a loop of some kind. As it turns out that is all that is missing from your code. The Dir command can help solve this problem:

Private Sub Check()
   Dim intFile As Integer
   Dim strFile As String
   Dim FolderName As String
   
   MkDir "c:\New_Folder"
   strFile = "c:\New_Folder\data.txt"
   intFile = FreeFile
   Open strFile For Output As #intFile
   FolderName = Dir("c:\windows\", vbDirectory)
   
   Do While FolderName <> ""
      If FolderName <> "." And FolderName <> ".." And (GetAttr("c:\windows\" & FolderName) And vbDirectory) = vbDirectory Then
         Print #intFile, FolderName
      End If

      FolderName = Dir()
   Loop
   
   Close #intFile
End Sub

I would also encourage you to use proper formatting of your code, in this case indentation. It will make your life easier at some point!

Upvotes: 2

Tim Williams
Tim Williams

Reputation: 166835

A basic example with no error checking:

Sub Tester()
    Dim f
    For Each f In AllFolders("D:\Analysis")
        Debug.Print f
    Next f
End Sub

'return all folders which are subfolders of `startFolder`
Function AllFolders(startFolder As String)
    Dim col As New Collection, colOut As New Collection, f, sf
    
    col.Add startFolder
    Do While col.Count > 0
        f = col(1) & IIf(Right(f, 1) <> "\", "\", "")
        col.Remove 1
        sf = Dir(f, vbDirectory)                    'fetch folders also
        Do While Len(sf) > 0
            If GetAttr(f & sf) = vbDirectory Then   'is this a folder ?
                If sf <> "." And sf <> ".." Then    'ignore self or parent
                    col.Add f & sf & "\"            'add to list to check for subfolders
                    colOut.Add f & sf               'add to output
                 End If
            End If
            sf = Dir
        Loop
     Loop
     Set AllFolders = colOut
End Function

Upvotes: 0

Related Questions