胁迫的小说:vb中list显示文件的类型

更改 Pattern 属性
如：FileList1.Pattern = "*.gif"
------------------------------------
ListBox可以这样。
这是我原来写的函数，你可以看一下。
'************************************************
'** 函数作者： 栽培者
'** 创建日期： 2004-04-24
'** 修改时间： 2005-08-27
'** 函数名称： GetFiles
'** 函数作用： 取得某个目录下的指定类型的文件名
'** 参数说明：
'** strSourceFolder 指定的目录，如：C:\
'** strReturn 要保存文件名的数组
'** strType 文件类型，如：mp3，多个时可用 , 分隔
'** strCondition 用来判断文件中是否包含这个字符串，可选，如：阿桑
'** blnSearchSubFolder 是否搜索子目录
'** 函数输出：
'** strReturn 一组文件名
'** 函数返回：
'** True 函数执行成功
'** False 函数执行失败
'** 函数举例：
'** Dim strFolders() As String
'**
'** Call GetFiles("C:\MyMusic\",strFolders,"mp3","阿桑")
'************************************************
Public Function GetFiles(ByVal strSourceFolder As String, _
ByRef strReturn() As String, _
Optional ByVal strType As String = "*", _
Optional ByVal strCondition As String = "", _
Optional ByVal blnSearchSubFolder As Boolean = False) As Boolean

Dim strFileName As String ' 文件名
Dim lngFolders As Long ' 文件夹数量
Dim lngFiles As Long ' 当前已经加载的文件数量
Dim strPostfix As String ' 后缀名
Dim intStrat As Integer ' "."的位置
Dim strFolders() As String ' 当前循环中的文件夹
Dim i As Long

'// 让鼠标样式处于等待状态
Screen.MousePointer = vbHourglass
On Error Resume Next

'// 给目录最后加上 \
If Right$(strSourceFolder, 1) <> "\" Then
strSourceFolder = strSourceFolder & "\"
End If

'// 初始化
strFileName = Dir(strSourceFolder, vbDirectory)

lngFolders = 1

'*********************************************
'// 遍历指定的目录
'*********************************************
Do While strFileName <> ""
DoEvents
'// 判断是否为根目录，如果是根目录就继续循环
If strFileName <> "." And strFileName <> ".." Then
'// 如果是目录，则记录它
If (GetAttr(strSourceFolder & strFileName) And vbDirectory) = vbDirectory Then
ReDim Preserve strFolders(1 To lngFolders)
strFolders(lngFolders) = strSourceFolder & strFileName
lngFolders = lngFolders + 1

Else

'// 找出 “.”的位置，即后缀
intStrat = InStrRev(strFileName, ".")

If intStrat > 0 Then
strPostfix = Mid$(strFileName, intStrat + 1)

'// 如果未指定类型，则准备将文件名增加到数组
If strType = "*" Then GoTo AddFileStep1

'// 判断是否为想要类型
If InStr(UCase(strType), UCase(strPostfix)) > 0 Then
AddFileStep1:
'// 判断是否有条件
If strCondition <> "" Then
If InStr(strFileName, strCondition) > 0 Then
GoTo AddFileStep2
End If
Else
AddFileStep2:
'***************************
'// 将当前文件名增加到数组
'***************************
lngFiles = UBound(strReturn) + 1
ReDim Preserve strReturn(lngFiles)
strReturn(lngFiles) = strSourceFolder & strFileName

End If
End If
End If

End If
End If

'// 继续下一个项目
strFileName = Dir
Loop
'*********************************************

'// 判断是否搜索子目录
If blnSearchSubFolder Then
For i = 1 To lngFolders - 1
Call GetFiles(strFolders(i), strReturn, strType, strCondition, blnSearchSubFolder)
Next
End If

'// 用来“制造”错误
If UBound(strReturn) >= 0 Then
GetFiles = True
End If

'// 判断是否有错误发生
Select Case Err.Number
'// 下标越界
Case 9
Err.Clear
GetFiles = False

Case Else
Err.Clear
GetFiles = True
End Select

'// 还原鼠标样式
Screen.MousePointer = vbDefault
End Function

'// 加载文件例子
'// 增加一个Command1 和 一个 List1 到窗体。
Private Sub Command1_Click()
Dim strFile() As String
Dim i As Long
Dim lngCount As Long

'// 加载 F:\Design\ 目录下载所有后缀为 gif、jpg、png，且文件名中包含“music”的文件
If GetFiles("F:\Design\", strFile, "gif,jpg,png", "music", True) Then
lngCount = UBound(strFile)

List1.Clear

For i = 0 To lngCount
List1.AddItem strFile(i)
Next

Debug.Print lngCount + 1
End If

End Sub