第一步：将以下代码复制到模块中：
'***************** 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"或以上的版本
