通過文件擴展名循環，excel vba

Question

我正在使用一個文件擴展數組並循環遍歷工作簿的文件夾。 代碼命名為Sheet（1）.name =“MyName”

我注意到即使"*.xlsm"不在數組中，它仍然打開並命名工作表。

這是代碼。 任何人都可以看到他們是否遇到同樣的問題並且能夠解決它。

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

HELLO.ABCD的舊版短（8.3）文件名看起來像ABCDEF~1.ABC - 請參閱擴展名截斷為3個字符。

在你的情況下，當你指定*.XLS時， GET.XLSM將是ABCDEF~1.XLS並且這個8.3表單也匹配 Win32 API FindFirstFile （這是Dir()在引擎蓋下調用的）。

只需過濾掉循環中的異常

If Not UCase$(MyFile) Like "*.XLSM" Then 
    ....

Answer 2

雖然Alex已經解決了您的查詢，但我已將下面的代碼更新為

• 確保它處理所有excel文件類型
• 處理已存在的工作表名稱（否則您的代碼將出錯）
• 清理並正確使用變量

• 在收盤時恢復活動

   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