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

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

CodePudding user response：

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!

CodePudding user response：

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

CodePudding user response：

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