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

【转】获得文件扩展名的函数

时 间:2012-05-14 15:54:53
作 者:竹笛   ID:8  城市:上海  QQ:2851379730点击这里给张志发消息
摘 要:转载的一个获得文件扩展名的函数。
正 文:

' Code courtesy of UtterAccess Wiki
' http://www.utteraccess.com/wiki/index.php/Category:FunctionLibrary
' Date contributed
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
'
' REV  DATE                          DESCRIPTION
' 1.0  2010-08-10              initial release
' 2.0  2010-09-03              replace w/ faster version, commented previous
' 2.1  2010-09-12              updated header/format, no functional change
'
'
'==============================================================================
' NAME: GetFileExtension
' RETURNS: Extension, including ".", or ZLS if extension not found
' Version 2000+ (Access 97 will require custom InStrRev function equivelent)
'==============================================================================
Public Function GetFileExtension(sFile As String) As String
On Error GoTo Error_Proc
Dim Ret As String
'=========================
 Dim iPos As Integer
'=========================

 iPos = InStrRev(sFile, ".")
 
 If iPos <> 0 Then
   'Previous version, 10% slower   Ret = Right(sFile, Len(sFile) - iPos + 1)
   Ret = Mid$(sFile, iPos)
 End If

'=========================
Exit_Proc:
 GetFileExtension = Ret
 Exit Function
Error_Proc:
 Select Case Err.Number
   Case Else
     MsgBox "Error: " & Trim(Str(Err.Number)) & vbCrLf & _
       "Desc: " & Err.Description & vbCrLf & vbCrLf & _
       "Procedure: GetFileExtension" _
       , vbCritical, "Error!"
 End Select
 Resume Exit_Proc
 Resume
End Function



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

常见问答:

技术分类:

相关资源:

专栏作家

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