2010-11-08 搜尋副檔名 (VB) 37282 0 VB 搜尋副檔名 (VB) Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long Private FoundFile() As String '存放傳回值的字串陣列 Private ntx As Long Private Sub Command1_Click() ntx = 0 Call GetDirPath("c:\", "*.mdb") Me.Caption = "ok" For i = 0 To UBound(FoundFile) List1.AddItem FoundFile(i) Next i End Sub Private Sub GetDirPath(CurrentPath As String, ByVal SearFile As String) On Error Resume Next Dim nI As Integer, nDirectory As Integer, i As Long Dim sFileName As String, sDirectoryList() As String 'First list all normal files in this directory Me.Caption = "搜尋中-" & CurrentPath sFileName = Dir(CurrentPath, vbHidden Or vbDirectory Or vbReadOnly Or vbSystem) Do While sFileName <> "" If UCase(sFileName) Like UCase(SearFile) Then i = GetAttr(CurrentPath + sFileName) If (i And vbDirectory) = 0 Then ReDim Preserve FoundFile(ntx) FoundFile(ntx) = CurrentPath + sFileName ntx = ntx + 1 End If End If If sFileName <> "." And sFileName <> ".." Then 'Ignore nondirectories If GetFileAttributes(CurrentPath & sFileName) _ And vbDirectory Then nDirectory = nDirectory + 1 ReDim Preserve sDirectoryList(nDirectory) sDirectoryList(nDirectory) = CurrentPath & sFileName End If End If sFileName = Dir Loop DoEvents 'Recursively process each directory For nI = 1 To nDirectory GetDirPath sDirectoryList(nI) & "\", SearFile Next nI End Sub 如有錯誤 歡迎指正 回首頁