1 VB如何获取某文件夹中所有文件的文件名

  发布时间：2009-08-31 11:02:11   查看：509次  字体：【大 中 小】  

法1 filelist控件

在窗体中添加drive控件、dir控件和filelist控件，然后在窗体加入如下代码：

'*********************************************************
'              Get the path of the dwg files
'*********************************************************
Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub

'*********************************************************
'          Get the path which contains the dwg files
'*********************************************************
Private Sub Drive1_Change()
    On Error GoTo driveerror
    Dir1.Path = Drive1.Drive
    Exit Sub
driveerror:
    MsgBox "驱动器错误!", vbExclamation, "Error"
    'Drive1.Drive = Dir1.Path

End Sub

Private Sub Form_Load()
    File1.Pattern = "*.dwg"  
    'File1.Visible = False
End Sub

上例只筛选*.dwg的文件，你要是想要得到多有文件名<不含子文件夹>可以设为*.*

这样用File1.Tiem可得到那些文件名了。

法2 dos命令

其实dos命令 dir c:\*\*\*.dwg> list.txt 也可以

法3 用VB函数Dir实现递归搜索目录
'函数GetExtName
'功能:得到文件后缀名(扩展名)
'输入:文件名
'输出:文件后缀名(扩展名)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetExtName(strFileName As String) As String
Dim strTmp As String
Dim strByte As String
Dim i As Long
For i = Len(strFileName) To 1 Step -1
strByte = Mid(strFileName, i, 1)
If strByte <>"." Then
strTmp = strByte + strTmp
Else
Exit For
End If
Next i
GetExtName = strTmp
End Function
Public Function search(ByVal strPath As String, Optional strSearch As String = "") As Boolean
Dim strFileDir() As String
Dim strFile As String
Dim i As Long

Dim lDirCount As Long
On Error GoTo MyErr
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
If strSearch = "" Then
Form1.List1.AddItem strPath + strFile
ElseIf LCase(GetExtName(strPath + strFile)) = LCase(GetExtName(strSearch)) Then
'满足搜索条件，则处理该文件
Form1.List1.AddItem strPath + strFile '将文件全名保存至列表框List1中
End If
End If
strFile = Dir
Wend
For i = 0 To lDirCount - 1
Form1.Label3.Caption = strPath + strFileDir(i)
Call search(strPath + strFileDir(i), strSearch) '递归搜索子目录
Next
ReDim strFileDir(0) '将动态数组清空
search = True '搜索成功
Exit Function
MyErr:
search = False '搜索失败
End Function
法4 用到了VBScript

       Set objFs = Nothing
        Set objFolder = Nothing
        Set objFs = CreateObject("Scripting.FileSystemObject")
        Set objFolder = objFs.GetFolder(strDirSvr)
        Set objFiles = objFolder.Files
        For Each FCnt In objFiles
            ReDim Preserve strFileSvr(ClbGetCnt(strFileSvr) + 1)
            ReDim Preserve strTimeSvr(ClbGetCnt(strFileSvr) + 1)
            strFileSvr(ClbGetCnt(strFileSvr)) = Trim$(FCnt.Name)
            strTimeSvr(ClbGetCnt(strFileSvr)) = Format$(FCnt.DateLastModified, "yyyymmddhhnnss")
        Next FCnt

法5 API

'========查找指定路径中的文件和目录列表==========
Public Function funFindDirectory(ByVal strDir As String, Optional vMode As Long = vbDirectory) As Integer
   Dim vFileNames As String
   Dim vLoop As Integer
   Dim vFileAttr As FILEATTRIB
   
  varFileCount = 0
   varDirCount = 0
  
   On Error GoTo lopErr
   
  If strDir = "" Then
     strDir = varCurrentPath
   End If
   
  If Right(Trim(strDir), 1) <>"\" Then
       strDir = Trim(strDir) &"\"
   End If
   strDir = UCase(strDir)
   
  vFileNames = Dir(strDir, vMode)
   ReDim Preserve vFiles(11)
   ReDim Preserve vDirectories(11)
   Err.Clear
   Do While vFileNames <>""
       varCurrentPath = strDir
       If vFileNames <>"." And vFileNames <>".." Then
         If (GetAttr(strDir &vFileNames) And vbDirectory) = vbDirectory Then
           If varDirCount Mod 10 = 0 Then
               ReDim Preserve vDirectories(varDirCount + 10)
               DoEvents
           End If
           funGetFileAttrib strDir &vFileNames, vDirectories(varDirCount)
           varDirCount = varDirCount + 1
         Else
           If varFileCount Mod 10 = 0 Then
               ReDim Preserve vFiles(varFileCount + 10)
               DoEvents
           End If
           funGetFileAttrib strDir &vFileNames, vFiles(varFileCount)
           varFileCount = varFileCount + 1
         End If
       End If
lopErr:
       vFileNames = Dir(, vbAlias)
   Loop
   funQuickSortFile vDirectories(), 0, varDirCount - 1
   funQuickSortFile vFiles(), 0, varFileCount - 1
   Exit Function
   'vErrorMessage = "File Not Found."
End Function

VB如何获取某文件夹中所有文件的文件名