简体   繁体   English

VBA Excel遍历文件夹

[英]VBA Excel looping through folder

I have a macro I'm trying to run on multiple workbooks within the same folder. 我有一个宏,我试图在同一文件夹中的多个工作簿上运行。 I currently have the following, but when I run it (by using F5 in VBA for excel), nothing happens. 我目前有以下内容,但是当我运行它时(通过在VBA中使用Excel的F5进行操作),什么都没有发生。 The excel VBA window simply flickers, but none of the workbooks, even the first one, is affected by the macro. excel VBA窗口只是闪烁,但是没有任何工作簿,即使第一个工作簿也受宏影响。 If it helps, sometimes F5 asks me to confirm that I'm running "Sheet1.DoAllFiles." 如果有帮助,有时F5会要求我确认我正在运行“ Sheet1.DoAllFiles”。 I'm very beginner, so I'm sure it's something simple I'm missing - but any help in getting this program to loop would be appreciated. 我是个初学者,因此我确定我很想念这简单的东西-但是,希望此程序循环运行对您有所帮助。 Thanks! 谢谢!

The looping code I found: 我发现的循环代码:

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

The macro that my loop should be calling: 我的循环应该调用的宏:

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

You have an extra Do While...Loop in there... 你有一个额外的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

In your Simplify() Sub you don't ever seem to reference WB , and all your Sheets references have no Workbook qualifier: by default they will reference the ActiveWorkbook, but you shouldn't rely on that. 在您的Simplify()子目录中,您似乎从未引用过WB ,并且所有工作Sheets引用都没有Workbook限定符:默认情况下,它们将引用ActiveWorkbook,但您不应依赖于此。 From your code it's not clear whether you intend to reference sheets in WB or in the workbook containing the code. 从您的代码中不清楚您是否打算参考WB或包含该代码的工作簿中的图纸。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM