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

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 :o)

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

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

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


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

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

On Jun 2, 11:45*pm, Charlie wrote:
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 :o)

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")