在指定的分区中搜索某个文件并获得文件路径的函数

时　间:2009-02-06 14:30:24
作　者:竹笛   ID：8  城市：上海  QQ：2851379730
摘　要:有时，我们知道一个C盘的一个文件(例如：1.gif)，当我们需要查找出这个文件的具体路径时，我们可以采用下面的代码来实现。
正　文:

第一步：将以下代码复制到模块中：
'***************** Code Start ***************
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Function fReturnFilePath(strFilename As String, _
    strDrive As String) As String

Dim varItm As Variant
Dim strFiles As String
Dim strTmp As String
   
    If InStr(strFilename, ".") = 0 Then
        MsgBox "Sorry!! Need the complete name", vbCritical
        Exit Function
    End If
   
    strFiles = ""
    With Application.FileSearch
        .NewSearch
        .LookIn = strDrive
        .SearchSubFolders = True
        .FileName = strFilename
        .MatchTextExactly = True
        .FileType = msoFileTypeAllFiles
        If .Execute > 0 Then
            For Each varItm In .FoundFiles
                strTmp = fGetFileName(varItm)
                If strFilename = strTmp Then
                    fReturnFilePath = varItm
                    Exit Function
                End If
            Next varItm
        End If
    End With
End Function

Private Function fGetFileName(strFullPath) As String
Dim intPos As Integer, intLen As Integer
    intLen = Len(strFullPath)
    If intLen Then
        For intPos = intLen To 1 Step -1
            'Find the last \
            If Mid$(strFullPath, intPos, 1) = "\" Then
                fGetFileName = Mid$(strFullPath, intPos + 1)
                Exit Function
            End If
        Next intPos
    End If
End Function

第二步：在窗体中建一个命令按钮Command1，在按钮的单击事件中写代码：
Private Sub Command1_Click()
strFilePath = fReturnFilePath("1.gif", "D:")
MsgBox "文件路径为:" & strFilePath
End Sub

第三步：在VBA的引用中，引用一下：Microsoft Office 8.0 Object Library"或以上的版本