VBA Excel遍历文件夹

问题描述

我有一个宏，我试图在同一文件夹中的多个工作簿上运行.我目前有以下内容，但是当我运行它时(通过在VBA中使用F5 for excel)，什么也没发生. excel VBA窗口只是闪烁，但是没有任何工作簿，即使第一个工作簿也受宏影响.如果有帮助，有时F5会要求我确认我正在运行"Sheet1.DoAllFiles".我是个初学者，所以我确定我很想念这简单的东西，但是对使该程序循环运行的任何帮助将不胜感激.谢谢！

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. The excel VBA window simply flickers, but none of the workbooks, even the first one, is affected by the macro. If it helps, sometimes F5 asks me to confirm that I'm running "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!

我发现的循环代码:

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 ...

You have an extra Do While...Loop in there...

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或包含该代码的工作簿中的图纸.

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. From your code it's not clear whether you intend to reference sheets in WB or in the workbook containing the code.

这篇关于VBA Excel遍历文件夹的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！