[英]VBA Excel looping through folder
我有一个宏,我试图在同一文件夹中的多个工作簿上运行。 我目前有以下内容,但是当我运行它时(通过在VBA中使用Excel的F5进行操作),什么都没有发生。 excel VBA窗口只是闪烁,但是没有任何工作簿,即使第一个工作簿也受宏影响。 如果有帮助,有时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
我的循环应该调用的宏:
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
你有一个额外的Do While...Loop
in ...
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()
子目录中,您似乎从未引用过WB
,并且所有工作Sheets
引用都没有Workbook限定符:默认情况下,它们将引用ActiveWorkbook,但您不应依赖于此。 从您的代码中不清楚您是否打算参考WB或包含该代码的工作簿中的图纸。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.