Looping through file extensions, excel vba - excel

Question

I am using an Array of File extensions and looping through a folder of workbooks. The code is naming Sheet(1).name="MyName"
I notice that even though "*.xlsm" is not in the array, it is still opening and naming the sheet.
Here's the code. Can anybody see if they get the same problem and are able to solve it.
Sub LoopThroughFolder()
Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range
Dim fExt, ext
Set Wb = ThisWorkbook
'change the address to suite
MyDir = "C:\TestWorkBookLoop\"
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
fExt = Array("*.xlsx", "*.xls") 'file extensions, set the file extensions of the files to move
For Each ext In fExt 'loop through file extensions
MyFile = Dir(MyDir & ext)
Do While MyFile <> ""
Workbooks.Open (MyFile)
Sheets(1).Name = "MySheet"
With ActiveWorkbook
.Save
.Close
End With
MyFile = Dir()
Loop
Next ext
End Sub

Answer 1

The legacy short (8.3) file name for HELLO.ABCD would look something like ABCDEF~1.ABC - see the extension is truncated to 3 characters.
In your case GET.XLSM would be ABCDEF~1.XLS and this 8.3 form is also matched by the Win32 API FindFirstFile (which is what Dir() calls under the hood) when you specify *.XLS
Just filter out the exceptions in you loop with
If Not UCase$(MyFile) Like "*.XLSM" Then
....

Answer 2

While Alex has solved your query, I have updated your code below to
ensure it handles all excel file types
handle the sheet name already existing (else your code will error out)
cleanup and properly use variables
restore events at close
Sub LoopThroughFolder()
Dim Wb As Workbook
Dim MyFile As String
Dim MyDir As String
Dim StrFile As String
MyDir = "C:\temp\"
ChDir MyDir
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
StrFile = "*.xls*"
MyFile = Dir(MyDir & StrFile)
Do While Len(MyFile) > 0
If MyFile Like "*.xlsx" Or MyFile Like "*.xlx" Then
Set Wb = Workbooks.Open(MyFile)
On Error Resume Next
Wb.Sheets(1).Name = "MySheet"
On Error GoTo 0
Wb.Save
Wb.Close False
End If
MyFile = Dir()
Loop
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub