Question

我的工作簿中有一个文件名列表。我想知道当名称不在该列表中时是否有人知道如何打开文件。例如，该列表包含文件“ab”，“bc”，“cd”和＆amp;的名称。 “德”。档案“ac”，“bd”＆amp; “eg”不在列表中，我只想打开那些文件，所以没有重复。我知道我可以删除重复，但是打开列表中已存在的文件非常耗时。我是VBA的新手，我对这个话题做过一些研究，但一无所获。我非常感谢能帮助我的人。谢谢！

所以这就是我到目前为止所得到的：

Sub Test1()

Dim File As String
Dim wb As Workbook
Dim wbList As Workbook
Dim filesRange As Range
Dim f As Range
Dim fileName As String
Dim Average As Double
Dim StdDev As Double
Dim OpenNum As Double
Dim Min As Double
Dim Max As Double
Dim wbDestination As Workbook

Const wbPath As String = "C:\Users\10 stop.xlsx"
Const pathToFiles As String = "C:\Users\J\"

File = Dir(pathToFiles, vbDirectory)

Set wbList = Workbooks.Open(wbPath)
Set filesRange = wbList.Sheets("18x17 - 10 mil stop").Range("A:A")

Do While Len(File) > 0
    Set f = filesRange.Find(What:=f, LookIn:=xlValues, Lookat:=xlWhole)
    If f Is Nothing Then
        Set wb = Workbooks.Open(pathToFiles & File)

        fileName = ActiveWorkbook.Name
        Worksheets(1).Select
        Average = Range("B15")
        Worksheets(1).Select
        StdDev = Range("B16")
        Worksheets(1).Select
        OpenNum = Range("B13")
        Worksheets(1).Select
        Min = Range("B17")
        Worksheets(1).Select
        Max = Range("B18")

        Set wbDestination = Workbooks.Open("C:\Users\10 stop.xlsx")
        Worksheets(ActiveSheet.Name).Select
        Worksheets(ActiveSheet.Name).Range("a1").Select
        RowCount = Worksheets(ActiveSheet.Name).Range("a1").CurrentRegion.Rows.Count
        With Worksheets(ActiveSheet.Name).Range("a1")
        .Offset(RowCount, 0) = fileName
        .Offset(RowCount, 1) = Average
        .Offset(RowCount, 2) = StdDev
        .Offset(RowCount, 3) = OpenNum
        .Offset(RowCount, 4) = Min
        .Offset(RowCount, 5) = Max
        End With
    End If
    File = Dir()
Loop
End Sub

我得到了运行时错误'5'：

上的无效过程调用或参数

Set f = filesRange.Find(What:=f, LookIn:=xlValues, Lookat:=xlWhole)

对于我想要打开和阅读的文件，我想使用通配符“ -10 _ .csv” 我尝试了很多不同的方法，但是所有这些方法都给了我空白页。我之前使用过'RecursiveDir'，但是当我尝试更新数据时，它很慢并且一遍又一遍地打开每个文件。这太令人沮丧了:( 请帮忙！

Answer 1

添加了子文件夹搜索。已编译但未经过测试。

Sub Test1()

Dim wb As Workbook
Dim wbList As Workbook
Dim filesRange As Range
Dim f As Range
Dim wbDestination As Workbook
Dim rw As Range
Dim allFiles As New Collection, File, fName

Const wbPath As String = "C:\Users\10 stop.xlsx"
Const pathToFiles As String = "C:\Users\J\"

    Set wbList = Workbooks.Open(wbPath)
    Set filesRange = wbList.Sheets("18x17 - 10 mil stop").Range("A:A")

    GetFiles pathToFiles, "*-10_.csv", True, allFiles

    For Each File In allFiles

        fName = FileNameOnly(File)

        Set f = filesRange.Find(What:=fName, LookIn:=xlValues, Lookat:=xlWhole)

        If f Is Nothing Then

            Set wb = Workbooks.Open(File)

            '***need to specify sheet name below...
            Set rw = wbList.Sheets("sheetname").Cells(Rows.Count, 1) _
                       .End(xlUp).Offset(1, 0).EntireRow

            rw.Cells(1).Value = fName 'or `File` if you want the full path
            With wb.Sheets(1)
                rw.Cells(2).Value = .Range("B15").Value 'avg
                rw.Cells(3).Value = .Range("B16").Value 'stdev
                rw.Cells(4).Value = .Range("B13").Value 'opennum
                rw.Cells(5).Value = .Range("B17").Value 'min
                rw.Cells(6).Value = .Range("B18").Value 'max
            End With
            wb.Close False 'don't save

        End If
    Next File

End Sub

'given a path, return only the filename
Function FileNameOnly(sPath)
Dim arr
    arr = Split(sPath, "\")
    FileNameOnly = arr(UBound(arr))
End Function




Sub GetFiles(StartFolder As String, Pattern As String, _
             DoSubfolders As Boolean, ByRef colFiles As Collection)

    Dim f As String, sf As String, subF As New Collection, s

    If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"

    f = Dir(StartFolder & Pattern)
    Do While Len(f) > 0
        colFiles.Add StartFolder & f
        f = Dir()
    Loop

    sf = Dir(StartFolder, vbDirectory)
    Do While Len(sf) > 0
        If sf <> "." And sf <> ".." Then
            If (GetAttr(StartFolder & sf) And vbDirectory) <> 0 Then
                    subF.Add StartFolder & sf
            End If
        End If
        sf = Dir()
    Loop

    For Each s In subF
        GetFiles CStr(s), Pattern, True, colFiles
    Next s

End Sub

Excel VBA打开工作簿而不重复它

1 个答案: