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

竹笛

' 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