VB批量提取文件夹名称

Question

我想将当前文件夹下文件夹名称提取出来，显示在。txt里面

Answer 1

'以下程序调试成功。 你新建工程后，在窗体上需要放置一个Text1，然后把代码全粘贴进去，运行。 最好把Text1的MultiLine属性设置为true，这样可以分行显示

Private Sub Form_Load()
Dim sF As String, c As Integer
Text1.Text = ""
sF = Dir(App.Path & "\", vbDirectory) ' 查找目录中第一个文件夹名称
Do While sF <> ""
' 跳过当前的目录及上层目录
If sF <> "." And sF <> ".." Then
If (GetAttr(sB + sF) And vbDirectory) = vbDirectory Then
Text1.Text = Text1.Text & sF & vbCrLf ' 如果它是一个目录，将其名称添加到text1.Text
c = c + 1
End If
End If
sF = Dir ' 查找下一个目录
Loop
MsgBox "共有" & c & "个文件夹"
End Sub追问

我只提取当前目录下面的文件夹名称，是程序所在当前目录哦！
提取出来的名称放在一个记事本文件里面。谢谢

追答

'改好了，程序运行完后。会自动打开123.txt记事本文件，不过记事本是最小化的。最后一句的shell是打开记事本，你可以去掉。

Private Sub Form_Load()
Dim sF As String
sF = Dir(App.Path & "\", vbDirectory) ' 查找程序所在目录中第一个文件夹名称
Open "123.txt" For Output As #1
Do While sF ""
' 跳过当前的目录及上层目录
If sF "." And sF ".." Then
If (GetAttr(sB + sF) And vbDirectory) = vbDirectory Then
Print #1, sF ' 如果它是一个目录，将其名称添加123.txt文件
End If
End If
sF = Dir ' 查找下一个目录
Loop
Close #1
Shell "notepad.exe 123.txt"
End Sub

追问

你好，还是不行呢？
If (GetAttr(sB + sF) And vbDirectory) = vbDirectory Then
能加HI好友吗

追答

我这里就正常的。运行结果是在123.txt里添加了4个文件夹名称。
你把它编译后放到C盘或D盘再运行看看。

追问

呵呵，现在可以了。谢谢你

Answer 2

Private Sub Command1_Click()
Text1.Text = ""
MyPath = "c:\" ' 指定路径。
MyName = Dir(MyPath, vbDirectory) ' 找寻第一项。
Do While MyName <> "" ' 开始循环。
' 跳过当前的目录及上层目录。
If MyName <> "." And MyName <> ".." Then
' 使用位比较来确定 MyName 代表一目录。
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
Text1.Text = Text1.Text & MyName & vbCrLf ' 如果它是一个目录，将其名称显示出来。
End If
End If
MyName = Dir ' 查找下一个目录。
Loop
End Sub追问

我只提取当前目录下面的文件夹名称，是程序所在当前目录哦