VB 利用API搜索文件（高分）

Option Explicit

Private Const DRIVE_REMOVABLE = 2

Private Const DRIVE_FIXED = 3

Private Const DRIVE_REMOTE = 4

Private Const DRIVE_CDROM = 5

Private Const DRIVE_RAMDISK = 6

Private StopFlag As Boolean

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Public Sub FileSearch(ByVal sPath As String, ByVal Filter As String)

Static lngFiles As Long

Dim sDir As String

Dim sSubDirs() As String

Dim lngIndex As Long

Dim lngTemp&

DoEvents

If StopFlag = True Then Exit Sub

Label1.Caption = "当前路径" &sPath

If Right(sPath, 1) <>局带 "\" Then sPath = sPath &"\"

sDir = Dir(sPath &Filter)

Do While Len(sDir)

lngFiles = lngFiles + 1

List1.AddItem sPath &sDir

sDir = Dir

Loop

lngIndex = 0

sDir = Dir(sPath &"*.*", vbDirectory)

Do While Len(sDir)

If Left(sDir, 1) <>"." And Left(sDir, 1) <桐并芦>".." Then

If GetAttr(sPath &sDir) And vbDirectory Then

lngIndex = lngIndex + 1

ReDim Preserve sSubDirs(1 To lngIndex)

sSubDirs(lngIndex) = sPath &sDir &"\"蔽芹

End If

End If

sDir = Dir

Loop

For lngTemp = 1 To lngIndex

Call FileSearch(sSubDirs(lngTemp), Filter)

Next lngTemp

End Sub

Public Sub StartSearch(ByVal Filter As String)

Dim nType As Long, s As String, sDrive As String, d As String

Dim pos As Integer

s = String(256, Chr(0))

GetLogicalDriveStrings Len(s), s

Do

pos = InStr(s, Chr(0))

sDrive = Left(s, pos - 1)

If Len(sDrive) = 0 Then Exit Do

s = Mid(s, pos + 1)

nType = GetDriveType(sDrive)

If nType = DRIVE_FIXED Then

d = Left(sDrive, 2) &"\"

FileSearch d, Filter

End If

Loop Until pos <= 0

End Sub

Private Sub Command1_Click() '测试

StartSearch "*.jpg"

End Sub

Private Sub Form_Unload(Cancel As Integer)

StopFlag = True

End Sub

'QQ加你了

用API的方式丛早比Dir也快不了多少的，因为目前而言，电脑运行速度的最大瓶颈就是硬盘，不管CPU、主板、内存、显卡有多快，在执行文件 *** 作时都不得不慢下来等待硬盘，所以不管软件编得多好多努力，对速度的提升都不大的。就像几十万辆车要排队过一条小桥，一次只能过一辆，那么即使所有车都是法拉利、保时捷，通过小桥的速度也比几十万台拖拉机甚至牛车快不了多少的！乎郑毁关键是要拓宽桥的宽度岁备，或者多建几座桥，比如把机械硬盘换成固态硬盘，速度就会有明显提升的。

excel vba调用windows API 快速查找所选择的文件

excel选中悉氏文件名清单、自动从“a1"文件夹中查找相应的文件。

ShellExecuteA,DataObject,Clipboard,find,SendKeys

Private Declare Function ShellExecute Lib "shell32.dll" Alias _

"ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As _

String, ByVal lpszFile As String, ByVal lpszParams As String, _

ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long

Const SW_SHOW = 5

Sub test()

Selection.Copy

Dim MyData As DataObject

Dim sTemp As String, s As String

Set MyData = New DataObject

MyData.GetFromClipboard

sTemp = MyData.GetText

s = Replace(sTemp, vbCrLf, "")

s = Replace(s, vbTab, "")

MyData.SetText (s)

MyData.PutInClipboard

ShellExecute 0&, "find", Range("a1"笑型), _

vbNullString, vbNullString, SW_SHOW

Application.Wait (Now + TimeValue("0:00:02"睁升散))

SendKeys s &"{ENTER}"

End Sub

---