[英]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.