Excel VBA打开工作簿而不复制它
我的工作簿中有一个文件名列表。 我想知道如果有人知道如何打开文件名称不在该列表中。 例如,列表包含文件“ab”,“bc”,“cd”和“de”的名称。 文件“ac”,“bd”和“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”,但是当我尝试更新数据时,它很慢并且一遍又一遍地打开每个文件。 这太令人沮丧了:(请帮忙!
增加了子文件夹search。 编译但未经testing。
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