VBA Excel循环文件夹

我有一个macros，我试图在同一个文件夹中的多个工作簿上运行。 我目前有以下，但是当我运行它（在Excel中使用VBA中的F5），没有任何反应。 Excel的VBA窗口只是闪烁，但没有一个工作簿，甚至第一个，都受macros观的影响。 如果有帮助，有时F5会问我确认我正在运行“Sheet1.DoAllFiles”。 我很初学，所以我确信这是简单的我错过了 – 但任何帮助，让这个程序循环，将不胜感激。 谢谢！

循环代码我发现：

Sub DoAllFiles() Dim Filename, Pathname As String Dim WB As Workbook 'Pathname = "G:\Google Drive\2013-2014\Testingbeforedeployment" 'One pathname is coded out depending on what computer I'm running it from Pathname = "C:\Users\Maptop\Google Drive\2013-2014\Testingbeforedeployment" Filename = Dir(Pathname & "\*.xls*") Do While Filename <> "" Application.DisplayAlerts = False Application.ScreenUpdating = False Do While Filename <> "" Set WB = Workbooks.Open(Pathname & "\" & Filename) 'open all files Call Simplify(WB) WB.Close SaveChanges:=True Set WB = Nothing Filename = Dir() Loop Application.DisplayAlerts = True Application.ScreenUpdating = True Loop End Sub 

我的循环应该调用的macros：

 Private Sub Simplify(WB As Workbook) Sheets.Add After:=Sheets(Sheets.Count) Const tlh As String = "Credited" With Sheets("Inventory") 'Change to suit Dim tl As Range, bl As Range Dim first_add As String, tbl_loc As Variant Set tl = .Cells.Find(tlh) If Not tl Is Nothing Then first_add = tl.Address Else MsgBox "Table does not exist.": Exit Sub End If Do If Not IsArray(tbl_loc) Then tbl_loc = Array(tl.Address) Else ReDim Preserve tbl_loc(UBound(tbl_loc) + 1) tbl_loc(UBound(tbl_loc)) = tl.Address End If Set tl = .Cells.FindNext(tl) Loop While tl.Address <> first_add Dim i As Long, lrow As Long, tb_cnt As Long: tb_cnt = 0 For i = LBound(tbl_loc) To UBound(tbl_loc) Set bl = .Cells.Find(vbNullString, .Range(tbl_loc(i)) _ , , , xlByColumns, xlNext) lrow = Sheets("Sheet1").Range("A" & _ Sheets("Sheet1").Rows.Count).End(xlUp).Row .Range(.Range(tbl_loc(i)).Offset(0, 3)(IIf(tb_cnt <> 0, 1, 0), 0), _ bl.Offset(-1, 0)).Resize(, 9).Copy _ Sheets("Sheet1").Range("A" & lrow).Offset(IIf(lrow = 1, 0, 1), 0) tb_cnt = tb_cnt + 1 Set bl = Nothing Next End With End Sub 

Answer 1

在那里你有一个额外的Do While...Loop …

 Sub DoAllFiles() Dim Filename, Pathname As String Dim WB As Workbook 'Pathname = "G:\Google Drive\2013-2014\Testingbeforedeployment" Pathname = "C:\Users\Maptop\Google Drive\2013-2014\Testingbeforedeployment" Filename = Dir(Pathname & "\*.xls*") Do While Filename <> "" Application.DisplayAlerts = False Application.ScreenUpdating = False Set WB = Workbooks.Open(Pathname & "\" & Filename) 'open all files Simplify WB '<<<EDIT WB.Close SaveChanges:=True Application.DisplayAlerts = True Application.ScreenUpdating = True Filename = Dir() Loop End Sub 

在您的Simplify() Sub中，您似乎没有引用WB ，并且所有Sheets引用都没有Workbook限定符：默认情况下，它们将引用ActiveWorkbook，但不应该依赖于此。 从您的代码中，您是否打算在WB中或在包含代码的工作簿中参考工作表并不清楚。