如何获取一个文件夹中所有子文件夹的列表并使用 vb 将其写入 txt 文件

Question

我想知道如何获取“C/Windows”中所有子文件夹的列表并将其写入 txt 文件。这是我的代码：

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

完整解释：写一个程序，比如打开D盘的文件夹（文件夹就是你的昵称）。在此文件夹中打开文件data.txt，在其中记下目录C:\Windows中所有文件夹的名称。 2. 编写一个从文件中读取信息的程序，该文件是用第一个程序打开的，并通过 MsgBox 皮肤将另一行传输到文件

Answer 1

每当问题被定义为“获取所有子文件夹的列表”和“写入文本文件”时，我知道我可能需要实现某种循环。事实证明，这就是您的代码中所缺少的全部。 Dir命令可以帮助解决这个问题：

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

我还鼓励您使用正确的代码格式，在本例中为缩进。它会让你的生活在某个时候更轻松！

Answer 2

请尝试下一个代码：

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

Answer 3

没有错误检查的基本示例：

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

如何获取一个文件夹中所有子文件夹的列表并使用 vb 将其写入 txt 文件

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

vba

loops

directory

vb6