Finding File Extension from Full Filename (VBA) (2007)

[Charlie]

Is there a better way of extracting the file extension from a full filename?

What I've got works BUT thought there may be a better way of writing it ...
Particularly when some people have some very weird filenames with lots of "."
and my current code only caters for 4 "."! You would think that would be
enough but.

New to VBA but trying my best )

Column A contains full filename:

..bmp
emailssent2003-4, 4-5.pst
A Person and B Person. Workshop C. Fire Safety Guidance..ppt
File With Dot No Extension.

Column B contains:

=FileExt($A1,"EXT")
=FileExt($A2,"EXT")
=FileExt($A3,"EXT")
=FileExt($A$,"EXT")

Function FileExt(Filename, part) As String
FileExt = "Error"
myStr = Mid(Filename, 1)
EXT = "N/A"
If Len(myStr) = 0 Then: EXT = "": Exit Function
xxx = Split(myStr, ".", 4, vbTextCompare)
If UBound(xxx) = 3 Then EXT = xxx(3)
If UBound(xxx) = 2 Then EXT = xxx(2)
If UBound(xxx) = 1 Then EXT = xxx(1)
If UBound(xxx) = 0 Then EXT = xxx(0)
If UBound(xxx) = 0 Then EXT = ""
If Left(EXT, 1) = "." Then EXT = Right(EXT, Len(EXT) - 1)
Select Case UCase(part)
Case "EXT": FileExt = EXT
Case Else: Filename = "part '" & part & "' not valid"
End Select
End Function

 

[Ron de Bruin]

See how I do it here (Example 2
http://www.rondebruin.nl/mail/folder1/mail1.htm

 

[Javed]

Is there a better way of extracting the file extension from a full filename?

What I've got works BUT thought there may be a better way of writing it ....
Particularly when some people have some very weird filenames with lots of"."
and my current code only caters for 4 "."! You would think that would be
enough but.

New to VBA but trying my best )

Column A contains full filename:

.bmp
emailssent2003-4, 4-5.pst
A Person and B Person. Workshop C. Fire Safety Guidance..ppt
File With Dot No Extension.

Column B contains:

=FileExt($A1,"EXT")
=FileExt($A2,"EXT")
=FileExt($A3,"EXT")
=FileExt($A$,"EXT")

Function FileExt(Filename, part) As String
  FileExt = "Error"
  myStr = Mid(Filename, 1)
  EXT = "N/A"
  If Len(myStr) = 0 Then: EXT = "": Exit Function
  xxx = Split(myStr, ".", 4, vbTextCompare)
  If UBound(xxx) = 3 Then EXT = xxx(3)
  If UBound(xxx) = 2 Then EXT = xxx(2)
  If UBound(xxx) = 1 Then EXT = xxx(1)
  If UBound(xxx) = 0 Then EXT = xxx(0)
  If UBound(xxx) = 0 Then EXT = ""
  If Left(EXT, 1) = "." Then EXT = Right(EXT, Len(EXT) - 1)
  Select Case UCase(part)
  Case "EXT": FileExt = EXT
  Case Else: Filename = "part '" & part & "' not valid"
  End Select
  End Function

If you are ready to use FileSystemObject then it is very
simple.FilName is the path of file.

Use following code:

Dim Ext as String ' For Holding Extension Name
Set FSO=CreateObject("Scripting.FileSystemObject")
Ext=FSO.GetExtensionName("FilName")