Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > Access数据库-模块/函数/VBA

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

时 间: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"或以上的版本



Access软件网QQ交流群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助