treesearch.bas

把图片缩小压缩成jpg格式并保存到sql数据库

Attribute VB_Name = "treesearch"
'先取得d:\的文件夹和文件，再一一添加进去就可以了

'你改改就可以了


Option Explicit

Private Sub Command1_Click()
Dim ff() As String '定义一个字符串数组用来保存找到的文件名称
Dim fn As Long '保存找到的文件数目
Dim i As Long
fn = treesearch("E:\", "*.rmvb", ff())
Print "找到文件数目为"; fn
For i = 1 To fn
List1.AddItem ff(i)
'Print ff(i)
Next
End Sub




'Module1
'--------------
Option Explicit
Public Function treesearch(ByVal sPath As String, ByVal sFileSpec As String, sFiles() As String) As Long
On Error Resume Next
Static Files As Long '文件数目
Dim sDir As String
Dim sSubDirs() As String '存放子目录名称
Dim Index As Long
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sDir = Dir(sPath & sFileSpec)
'获得当前目录下文件名和数目
Do While Len(sDir)
Files = Files + 1
ReDim Preserve sFiles(1 To Files)
sFiles(Files) = sPath & sDir
sDir = Dir
Loop
'获得当前目录下的子目录名称
Index = 0
sDir = Dir(sPath & "*.*", 16)
Do While Len(sDir)
If Left(sDir, 1) <> "." Then 'skip.and..
'找出子目录名
If GetAttr(sPath & sDir) And vbDirectory Then
Index = Index + 1
'保存子目录名
ReDim Preserve sSubDirs(1 To Index)
sSubDirs(Index) = sPath & sDir & "\"
End If
End If
sDir = Dir
Loop
For Index = 1 To Index
'查找每一个子目录下文件，这里利用了递归
Call treesearch(sSubDirs(Index), sFileSpec, sFiles())
Next Index
treesearch = Files
End Function