Выполнить цикл без цикла по папке

У меня есть около 1000 файлов в папке, которые я хочу просмотреть по отдельности, обработать данные, а затем скопировать / вставить в отдельную книгу * .xlsx. Кажется, есть проблема с кодом, который «обрабатывает» данные, потому что, когда я пытаюсь вернуться к Do-While-Loop, он не открывает следующий файл. Если я не запустил дополнительный код, он будет перебирать все файлы

Sub LoopThroughSingle_TXT_Files()
    Dim currentPath As String
    Dim currentFile As String

    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:="D:\Folder2\cd1.xlsx"
    Dim cd1 As Workbook
    Set cd1 = Workbooks("cd1")

    currentPath = "D:\Folder1\Data\"
    currentFile = Dir(currentPath & "*.txt")
    Do While currentFile <> ""
        Workbooks.Add
        ActiveWorkbook.SaveAs Filename:="D:\Folder1\Data\wb1.xlsx"

        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & currentPath & currentFile, Destination:=Range("$A$1"))
            .NAME = "Data"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With

        Module3.z_CleanData
        Module3.zz_paste_in_combined()

        currentFile = Dir

    Loop
    Application.ScreenUpdating = True

End Sub

Sub z_Clean_Data()

    Range("M2").Activate:     ActiveCell.FormulaR1C1 = "=IFS(AND(RC1="""",RC[-11]=""""),R[-1]C[-11],AND(RC1=1,RC[-11]=""""),R[1]C[-11],RC[-11]<>"""",RC[-11])"
    Range("N2").Activate:     ActiveCell.FormulaR1C1 = "=IFS(AND(RC1="""",RC[-11]=""""),R[-1]C[-11],AND(RC1=1,RC[-11]=""""),R[1]C[-11],RC[-11]<>"""",RC[-11])"
    Range("O2").Activate:     ActiveCell.FormulaR1C1 = "=IFS(AND(RC1="""",RC[-11]=""""),R[-1]C[-11],AND(RC1=1,RC[-11]=""""),R[1]C[-11],RC[-11]<>"""",RC[-11])"
    Range("P2").Activate:     ActiveCell.FormulaR1C1 = "=IFS(AND(RC1="""",RC[-11]=""""),R[-1]C[-11],AND(RC1=1,RC[-11]=""""),R[1]C[-11],RC[-11]<>"""",RC[-11])"
    Range("Q2").Activate:    ActiveCell.FormulaR1C1 = "=IF(RC[-11]="""",R[-1]C[-11],RC[-11])"
    lastRow = Cells(Rows.Count, "B").End(xlUp).Row
    Range("M2:Q" & lastRow).Activate:   Selection.FillDown:     Selection.Copy
    Range("B2").Activate:   Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False:    Application.CutCopyMode = False
    Range("M:Q").Delete

    Application.Goto Reference:="R1C1:R500C6":      Selection.Copy

End Sub

Sub zz_paste_in_combined()

    Dim wb1 As Window
    For Each wb1 In Application.Windows
        If wb1.Caption Like "wb1*.xlsx" Then
            wb1.Activate
            Exit For
        End If
    Next

    Dim cd1 As Window
    For Each cd1 In Application.Windows
        If cd1.Caption Like "cd1*.xlsx" Then
            cd1.Activate
            Exit For
        End If
    Next

    cd1.Activate
    Range("A1").End(xlDown).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False:
    Application.CutCopyMode = False

    wb1.Activate
    ActiveWorkbook.Close SaveChanges:=False

    '###Clear files from combined_data if it exists
    Dim myFilePath2Delete As String:    myFilePath2Delete = "D:\Kibot\Data\!Daily Data (saved as EOD)\Volume-Price Screen\zNuLong_Analysis_Individual\.xlsx"
    If Dir(myFilePath2Delete) <> "" Then
        Kill myFilePath2Delete
    End If

End Sub

Я пробовал так много разных способов найти решение, но не смог заставить его работать так, как я хочу. Я действительно не уверен в том, как обработать данные, вставить их в другую книгу и затем продолжить цикл Do-While-Loop, не допуская его неожиданного завершения.

Заранее благодарим вас за любой вклад.

Стивен


while-loop excel vba do-while
person Steven Fussner    schedule 30.09.2018    source источник
comment
Я предполагаю, что ваше неявное использование ActiveSheet / ActiveWorkbook и Select вызывает проблемы. См. stackoverflow.com/questions/30387819/ и stackoverflow.com/questions/10714251 /   -  person ComputerVersteher    schedule 01.10.2018
comment
Если вы вызываете dir с аргументами в дополнительном коде, usingdir() без аргументов при возвращении в цикл из 1000 файлов теперь будет использовать аргументы, которые вы передали ему в последний раз в дополнительном коде. Если это проблема, вы можете создать массив строк и заранее назначить ему все 1000 файлов. Затем выполните цикл по массиву, что дает вам возможность снова использовать dir в дополнительном коде. Надеюсь, это имеет смысл.   -  person chillin    schedule 01.10.2018

Ответы (1)


arrow_upward
0
arrow_downward

Я буду работать примерно так:

Sub mymacro()

Dim objFile As Scripting.File
Dim objFolder As Scripting.Folder
Dim mywb as string

Set objFolder = CreateObject("Shell.Application").Namespace(objFolder.Path)

    'Loop through each file in the folder
    For Each objFile In objFolder.Files

     objFile.Open (objFile.Path)

     mywb = objFile.Name

     Workbooks.Add
     ‘Your code here

    Next objFile

End sub

надеюсь это поможет!!

person Community    schedule 30.09.2018