VBA Excel looping through folder

2019-09-07 05:49发布

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!

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

标签: excel vba loops
1条回答
2楼-- · 2019-09-07 06:28

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

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.

查看更多
登录 后发表回答