CODEWITHSUNDEEP
excelvba
Davesexcel
Davesexcel

Reputation: 6984

Looping through file extensions, excel vba

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.

enter image description here

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

Upvotes: 2

Views: 1663

Answers (2)

brettdj
brettdj

Reputation: 55672

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

Upvotes: 3

Alex K.
Alex K.

Reputation: 175768

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 
    ....

Upvotes: 7

Related Questions