How to extract file extensions?

[What-A-Tool]

I have a directory listing for all the files in a particular drive.
With excel macros, I have extracted filenames with extension in column
E. like filename.xxx

i need to extract the extensions in Column F. Now, column E does not
have all files with extensions.

Extension should be extracted with a condition of having a dot and 3
letter extension.

Can someone please help me in writing a small code?

Put this together for use in an Access database I worked on a while back -
not claiming its the best way - some of the more knowledgeable people around
here may be able to point out a better method - but its always worked for
me.
Good luck - Sean

Private Function GetExtension(ByVal strPath As String) As String
'Get file extension from file name
Dim intPtLoc As Integer
intPtLoc = InStrRev(strPath, ".")
GetExtension = UCase(Right(strPath, (Len(strPath) - (intPtLoc))))
End Function

 

[What-A-Tool]

Put this together for use in an Access database I worked on a while back -
not claiming its the best way - some of the more knowledgeable people
around here may be able to point out a better method - but its always
worked for me.
Good luck - Sean

Private Function GetExtension(ByVal strPath As String) As String
'Get file extension from file name
Dim intPtLoc As Integer
intPtLoc = InStrRev(strPath, ".")
GetExtension = UCase(Right(strPath, (Len(strPath) - (intPtLoc))))
End Function

Sorry - saw Dave Petersons post after I sent mine, and realized I answered a
different question than u asked.

 

[DK]

I have a directory listing for all the files in a particular drive.
With excel macros, I have extracted filenames with extension in column
E. like filename.xxx

i need to extract the extensions in Column F. Now, column E does not
have all files with extensions.

Extension should be extracted with a condition of having a dot and 3
letter extension.

Can someone please help me in writing a small code?

 

[Dave Peterson]

You could use a formula in column G:
=if(mid(f1,len(f1)-3,1)=".",right(f1,3),"")
to show xxx.

=if(mid(f1,len(f1)-3,1)=".",right(f1,4),"")
to show .xxx

In code:

Option Explicit
Sub testme()

Dim myCell As Range
Dim myRng As Range

With Worksheets("sheet1")
Set myRng = .Range("F1", .Cells(.Rows.Count, "F").End(xlUp))
End With

For Each myCell In myRng.Cells
If Mid(myCell.Value, Len(myCell.Value) - 3, 1) = "." Then
myCell.Offset(0, 1).Value = Right(myCell.Value, 3)
'should column F have the extension dropped?
'myCell.Value = Left(myCell.Value, Len(myCell.Value) - 4)
Else
myCell.Offset(0, 1).Value = ""
End If
Next myCell
End Sub

 

[Dave Patrick]

=IF(MID(RIGHT(E1,4),1,1)=".",RIGHT(E1,3),"none")

--

Regards,

Dave Patrick ....Please no email replies - reply in newsgroup.
Microsoft Certified Professional
Microsoft MVP [Windows]
http://www.microsoft.com/protect

 

[DK]

Thank you so much Dave!
I will test this out!

You could use a formula in column G:
=if(mid(f1,len(f1)-3,1)=".",right(f1,3),"")
to show xxx.

=if(mid(f1,len(f1)-3,1)=".",right(f1,4),"")
to show .xxx

In code:

Option Explicit
Sub testme()

Dim myCell As Range
Dim myRng As Range

With Worksheets("sheet1")
Set myRng = .Range("F1", .Cells(.Rows.Count, "F").End(xlUp))
End With

For Each myCell In myRng.Cells
If Mid(myCell.Value, Len(myCell.Value) - 3, 1) = "." Then
myCell.Offset(0, 1).Value = Right(myCell.Value, 3)
'should column F have the extension dropped?
'myCell.Value = Left(myCell.Value, Len(myCell.Value) - 4)
Else
myCell.Offset(0, 1).Value = ""
End If
Next myCell
End Sub