Укажите файлы с расширением xlsx в VBA

Question

Как мне настроить оператор if на прием только файлов xlsx из указанной папки?

Привет! Я запускаю макрос, который берет файлы Excel из нескольких папок и подпапок, а затем компилирует их в один файл Excel. Он решает, какой файл извлекать, поскольку только 1 файл может быть извлечен из местоположения, называемого тестом Гувера.

Соответствующая часть макроса находится здесь, и я хочу изменить цикл для распознавания только файлов ".xlsx":

Sub DoFolder(Folder)
Dim SubFolder As Folder
Dim i As Integer
Dim CopyR As Range


For Each SubFolder In Folder.SubFolders
    DoFolder SubFolder


Next


If Folder.SubFolders.Count = 0 Then
    If Folder.Files.Count = 1 Then
          Else: MsgBox "2+ files: " & Folder.Path
    End If
    For Each File In Folder.Files
        Hoover File
    Next

Else
End If



End Sub

Это хорошо работает для проверки двух файлов в папке, но я хочу взять только файл xlsx из этой папки.

Полный макрос здесь, если необходимо:

'Option Explicit
Public wbm As Workbook
Public wbk As Workbook
Public File As File

Sub CM()

Dim FileSystem As Object
Dim HostFolder As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
HostFolder = "C:\Review Pack\Hoover Test"
Set FileSystem = CreateObject("Scripting.FileSystemObject")
Set wbm = ThisWorkbook
DoFolder FileSystem.GetFolder(HostFolder)
For Each sht In wbm.Worksheets
    sht.Cells.Replace what:="" & Chr(10) & "", Replacement:=" ",     LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,     ReplaceFormat:=False
Next sht
Application.ScreenUpdating = True
'LightOff
MsgBox "Done"
End Sub

Sub DoFolder(Folder)
Dim SubFolder As Folder
Dim i As Integer
Dim CopyR As Range


For Each SubFolder In Folder.SubFolders
    DoFolder SubFolder


Next


If Folder.SubFolders.Count = 0 Then
    If Folder.Files.Count = 1 Then
          Else: MsgBox "2+ files: " & Folder.Path
    End If
    For Each File In Folder.Files
        Hoover File
    Next

Else
End If



End Sub

Sub Hoover(File)
Dim i As Integer
Dim LineNo As Integer
Set wbk = Workbooks.Open(File.Path, , False)
Application.AskToUpdateLinks = False


If wbk.MultiUserEditing Then
    wbk.ExclusiveAccess
End If
For i = 2 To 11

    If Sheets(i).FilterMode Then
        wbk.Sheets(i).Unprotect "x"
        Sheets(i).Cells.AutoFilter
    End If

    LineNo = wbm.Sheets(i).Range("A" & Rows.Count).End(xlUp).Row + 1
    wbm.Sheets(i).Range("A" & LineNo & ":" & "AB" & LineNo + 990).Value =    wbk.Sheets(i).Range("A10:AB1000").Value
Next i
     wbk.Close False

End Sub

Answer 1

У вас есть объект файловой системы, готовый и ожидающий. Использование:

FileSystem.GetExtensionName(file) = "xlsx" 

или

Right$(file.Path, Len(file.Path) - InStrRev(file.Path, "."))

Answer 2

Что ж, я заблудился с вашими условными инструкциями в скрипте DoFolder, но я думаю, что вы хотите выполнить какое-то действие, только если подпапка содержит как минимум 2 файла .xlsx. Я думаю, что вы можете перебрать все файлы в подпапках и просто проверить, есть ли в их имени строка ".xlsx" или ".xls". Последний вариант будет также учитывать .xlsm и .xlsb.

Вы можете использовать эту функцию:

Function CountXLS(folder) As Long
    Dim f As Object
    Dim cnt As Long

    For Each f In folder.Files
        If InStr(f.Name, ".xls") Then cnt = cnt + 1
        'If InStr(f.Name, ".xlsx") Then cnt = cnt + 1 'more precise variant
    Next f

    CountXLS = cnt

End Function

Answer 3

измените цикл для файлов на

For Each File In Folder.Files
    If LCase(Right(File.Name, 5)) = ".xlsx" Then
        Hoover File
    End If
Next