Looping through file extensions, excel vba

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