VB 怎么得到文件夹里所有的TXT文件的文件名？并保存在数组中？

比如说我电脑 E 盘 的 test 文件夹里面有 1.txt , 2.txt , 3.txt 3个文本文件
我想设置为：

       点击按钮 ->弹出选择路径对话框，（选择路径为:E:/test)
点击另外一个按钮->E:/test 里面的文件名全部保存到数组 abc()里面，其中a(0)="1.txt",a(1)="2.txt",a(2)="3.txt",

我是想把一堆TXT文件仍进一个文件夹里面，然后用程序把它们一次编辑！

点击得到文件,我用如下方法：（但是只能得到一个文件，我想选一次路径就得到所有的TXT文件 怎么实现?)
dim a as string
With Application.FileDialog(msoFileDialogFilePicker)
If .Show = -1 Then
a=.SelectedItems (1)
End If
End With

请高手指点指点！

14 个解决方案

#1

加个drive 和 dir。然后用dir或FSO。遍历txt文件。

#2

dir+Split,我用这个做过遍历图片抽奖

#3

用fileListbox控件实现简单,循环得逗号分割的文件名字符串,用split分割为数组即可

#4

一个通用的VB磁盘文件搜索引擎类:
http://blog.csdn.net/lyserver/archive/2009/07/31/4397098.aspx

#5

Public Function GetPathFiles(Llist As Object, pschdir$, pExtName$, Optional subyn As Boolean = False) As Long
   tfiles = 0
   subsch = subyn
   s = Split(pExtName, ";")
   For j = 0 To UBound(s)
      ReDim Preserve subpattern$(j)
      subpattern(j) = s(j)
   Next j
   maxpattern = UBound(s) + 1
   Call DGsearch(Llist, pschdir)
   GetPathFiles = tfiles
End Function

Private Sub DGsearch(Llist As Object, strpath$)
   On Error Resume Next
   Dim strFileDir$(), strFile$, dircount&, lDirCount&
   If Right(strpath, 1) <> "\" Then strpath = strpath & "\"
   strFile = Dir(strpath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
   While strFile <> ""   '搜索当前目录
      DoEvents
      If (GetAttr(strpath & strFile) And vbDirectory) = vbDirectory Then '如果找到的是目录
         If strFile <> "." And strFile <> ".." Then     '排除掉父目录(..)和当前目录(.)
            lDirCount = lDirCount + 1 '将目录数增1
            ReDim Preserve strFileDir(lDirCount) As String
            strFileDir(lDirCount - 1) = strFile '用动态数组保存当前目录名
         End If
      Else
         For j = 0 To maxpattern - 1
            aa = subpattern(j)
            If aa = "" Then
               If UCase(Right(aa, 3)) = UCase(Right(Trim(strFile), 3)) Or subpattern(j) = "*.*" Then Llist.AddItem strpath & strFile: tfiles = tfiles + 1: Exit For
               ElseIf UCase(Right(aa, 3)) = UCase(Right(Trim(strFile), 3)) Or subpattern(j) = "*.*" Then
               Llist.AddItem strpath & strFile: tfiles = tfiles + 1: Exit For
            End If
         Next j
      End If
      strFile = Dir
   Wend
   If subsch Then
      For dircount = 0 To lDirCount - 1
         Call DGsearch(Llist, strpath & strFileDir(dircount)) '递归搜索子目录
      Next dircount
      ReDim strFileDir(0) '将动态数组清空
   End If
End Sub



本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/cbm666/archive/2008/03/08/2158656.aspx

#6

FileSystemObject对象
用Folder获得 Files
然后遍历Files
file对象可得到扩展名
获得所有.txt

#7

直接用 Dir() 函数即可：

Dim strFile As String

List1.Clear
strFile = Dir("E:/test/*.txt")

Do Until strFile = ""
    List1.AddItem strFile
    strFile = Dir
Loop

#8

Dim Trec&, SelPath$, Stmp$, TmpFile$()
Private Sub Command1_Click()
   SelPath = SelectPath
   If SelPath = "" Then Exit Sub
   Trec = 0
   Stmp = Dir(SelPath & "\*", vbDirectory)
   While Stmp <> vbNullString
      If UCase(Right(Stmp, 3)) = "TXT" Then
         ReDim Preserve TmpFile$(Trec)
         Trec = Trec + 1
      End If
      Stmp = Dir()
   Wend
   MsgBox "搜索完成! 共搜索到 " & CStr(Trec) & " 个文件"
   'If Trec > 0 Then MsgBox UBound(TmpFile) '在这里可以得知数组上标(几个文件+1)
End Sub

Public Function SelectPath() As String
   On Error GoTo errhandler '有错误或选择取消返回32755的错误代号,执行错误处理副程序
   Set SFshell = CreateObject("Shell.Application") '创建对像
   Set SelFolder = SFshell.BrowseForFolder(0, "选择目录:", 0, "e:\test") '定义spFolder=定义对像展开目录,e:\test是予设的展开路径
   Set SelFolderItem = SelFolder.Self '定义spFolderItem
   SelectPath = SelFolderItem.Path 'SelectPath=选中的spFolderItem文件夹路径
errhandler: '错误处理副程序
   If Err > 0 Then Exit Function '有错误或按了取消即退出这个sub
End Function

#9

对！使用Dir即可。
Dir 函数
      

返回一个 String，用以表示一个文件名、目录名或文件夹名称，它必须与指定的模式或文件属性、或磁盘卷标相匹配。

语法

Dir[(pathname[, attributes])]

Dir 函数的语法具有以下几个部分：

部分 描述 
pathname 可选参数。用来指定文件名的字符串表达式，可能包含目录或文件夹、以及驱动器。如果没有找到 pathname，则会返回零长度字符串 ("")。 
attributes 可选参数。常数或数值表达式，其总和用来指定文件属性。如果省略，则会返回匹配 pathname 但不包含属性的文件。  


设置值

attributes 参数的设置可为：

常数 值 描述 
vbNormal 0 (缺省) 指定没有属性的文件。 
vbReadOnly 1 指定无属性的只读文件 
vbHidden 2 指定无属性的隐藏文件 
VbSystem 4 指定无属性的系统文件 
vbVolume 8 指定卷标文件；如果指定了其它属性，则忽略vbVolume 
vbDirectory 16 指定无属性文件及其路径和文件夹。 


注意 这些常数是由 VBA 所指定的，在程序代码中的任何位置，可以使用这些常数来替换真正的数值。

说明

Dir 支持多字符 (*) 和单字符 (?) 的通配符来指定多重文件。

 由于 Macintosh 不支持通配符，使用文件类型指定文件组。可以使用 MacID 函数指定文件类型而不用文件名。比如，下列语句返回当前文件夹中第一个TEXT文件的名称:

Dir("SomePath", MacID("TEXT"))

 为选中文件夹中所有文件，指定一空串:

Dir("")

在 Microsoft Windows 中，如果在Dir函数中使用MacID函数，将产生错误。

任何大于256的attribute值都被认为是MacID 函数的值。

在第一次调用 Dir 函数时，必须指定 pathname，否则会产生错误。如果也指定了文件属性，那么就必须包括 pathname。

Dir 会返回匹配 pathname 的第一个文件名。若想得到其它匹配 pathname 的文件名，再一次调用 Dir，且不要使用参数。如果已没有合乎条件的文件，则 Dir 会返回一个零长度字符串 ("")。一旦返回值为零长度字符串，并要再次调用 Dir 时，就必须指定 pathname，否则会产生错误。不必访问到所有匹配当前 pathname 的文件名，就可以改变到一个新的 pathname 上。但是，不能以递归方式来调用 Dir 函数。以 vbDirectory 属性来调用 Dir 不能连续地返回子目录。

提示 由于文件名并不会以特别的次序来返回，所以可以将文件名存储在一个数组中，然后再对这个数组排序。

#10

DIR+递归

#11

'更正上面代码的错误

Dim Trec&, SelPath$, DirStr$, FileSZ$()
Private Sub Command1_Click()
   SelPath = SelectPath
   If SelPath = "" Then Exit Sub
   Call SearchFile(SelPath, "txt")
End Sub

Sub SearchFile(Spath$, ExtNm$)
   If Right(SchPath, 1) <> "\" Then SchPath = SchPath & "\"
   ExtNm = UCase(ExtNm)
   Me.Cls
   Trec = 0
   DirStr = Dir(Spath & "\*", vbNormal + vbHidden)
   If DirStr = "" Then Exit Sub
   If UCase(Right(DirStr, 3)) = ExtNm Then
      ReDim Preserve FileSZ(0)
      FileSZ(0) = Spath & DirStr
      Print FileSZ(0)
      Trec = 1
   End If
   While DirStr <> vbNullString
      If UCase(Right(DirStr, 3)) = ExtNm Then
         ReDim Preserve FileSZ$(Trec)
         FileSZ(Trec) = Spath & DirStr
         Print FileSZ(Trec)
         Trec = Trec + 1
      End If
      DirStr = Dir()
   Wend
   MsgBox "搜索完成! 共搜索到 " & CStr(Trec) & " 个文件"
End Sub

Public Function SelectPath() As String
  On Error GoTo errhandler '有错误或选择取消返回32755的错误代号,执行错误处理副程序
  Set SFshell = CreateObject("Shell.Application") '创建对像
  Set SelFolder = SFshell.BrowseForFolder(0, "选择目录:", 0, "e:\test") '定义spFolder=定义对像展开目录,e:\test是予设的展开路径
  Set SelFolderItem = SelFolder.Self '定义spFolderItem
  SelectPath = SelFolderItem.Path 'SelectPath=选中的spFolderItem文件夹路径
errhandler: '错误处理副程序
  If Err > 0 Then Exit Function '有错误或按了取消即退出这个sub
End Function

#12

谢谢各位大侠，特别感谢 of123 & cbm666两位！
把两位的代码加起来 问题得到解决，如下：
Dim SelPath$
Private Sub CommandButton1_Click()
Dim strFile As String
Dim file As String
Dim ABC(1 To 100)
Dim a
a = 1
 SelPath = SelectPath
file = SelPath & "/*.txt"
strFile = Dir(file)

Do Until strFile = ""
 ABC(a) = strFile
  strFile = Dir
  a = a + 1
Loop
a = 1
Do While ABC(a) <> Empty
Cells(1, a) = ABC(a)
a = a + 1
Loop
End Sub
Public Function SelectPath() As String
  On Error GoTo errhandler '有错误或选择取消返回32755的错误代号,执行错误处理副程序
  Set SFshell = CreateObject("Shell.Application") '创建对像
  Set SelFolder = SFshell.BrowseForFolder(0, "选择目录:", 0, "") '定义spFolder=定义对像展开目录,e:\test是予设的展开路径
  Set SelFolderItem = SelFolder.Self '定义spFolderItem
  SelectPath = SelFolderItem.Path 'SelectPath=选中的spFolderItem文件夹路径
errhandler: '错误处理副程序
  If Err > 0 Then Exit Function '有错误或按了取消即退出这个sub
End Function
另外 dbcontrols 提供的代码也能查出有几个文件，但不能查到个文件名字，看了半天，还是有以下一块不明白，请指点一下小弟，谢谢！
For j = 0 To maxpattern - 1
            aa = subpattern(j)
            If aa = "" Then
               If UCase(Right(aa, 3)) = UCase(Right(Trim(strFile), 3)) Or subpattern(j) = "*.*" Then Llist.AddItem strpath & strFile: tfiles = tfiles + 1: Exit For
               ElseIf UCase(Right(aa, 3)) = UCase(Right(Trim(strFile), 3)) Or subpattern(j) = "*.*" Then
               Llist.AddItem strpath & strFile: tfiles = tfiles + 1: Exit For
            End If
         Next j

#13

shell "dir /a-d /b E:\test\*.txt >e:\alltxtfiles.txt",vbHide
'然后读文件e:\alltxtfiles.txt的内容

#14

引用 13 楼 zhao4zhong1 的回复:

shell "dir /a-d /b E:\test\*.txt >e:\alltxtfiles.txt",vbHide
'然后读文件e:\alltxtfiles.txt的内容

纠正：
shell " cmd /c dir /a-d /b E:\test\*.txt >e:\alltxtfiles.txt",vbHide
'然后读文件e:\alltxtfiles.txt的内容