Question

如何将if语句设置为仅从指定文件夹中获取xlsx文件？

您好我正在运行一个宏，它从多个文件夹和子文件夹中获取excel文件，然后将这些文件编译成一个excel文件。它决定要提取哪个文件，因为只能从名为hoover test的位置提取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

将文件循环更改为

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

Answer 2

您已准备好等待的文件系统对象。使用：

FileSystem.GetExtensionName(file) = "xlsx"

或

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

Answer 3

好吧，我在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

在VBA中指定具有xlsx扩展名的文件

3 个答案: