Как искать файлы (.txt) в папке, импортировать данные с разделителями из файла в Excel, а затем перемещать TXT-файл в архив? - PullRequest
0 голосов
/ 25 сентября 2019

У меня есть папка, которая будет заполняться файлами с общими символами, но с разницей в одну цифру, т. Е. Тест 34 или тест 40. Папка может быть пустой или содержать 50 файлов.

Iпытаюсь написать код, который может:

  1. перейти к проверке папки, если папка пуста, если нет
  2. взять каждый текстовый файл и импортировать данные с разделителями-пробелами в Excel (в идеале на основедата изменения файла в папке - пока не получилось.)
  3. Переместить файлы в папку архива (может вызвать проблемы, если имя файла уже существует в архиве)
  4. , если папка пуста,exit / end sub

Я пробовал разные методы, но мои знания VBA невелики.Ниже приведена версия моего кода, которая была объединена с различным кодом из stackoverflow

Sub ImportFiles()
Dim eRow As String
Dim fileName As String
Dim rowNumber As String
Dim outputSheet As String
Dim sheetName As String
Dim folder As String
Dim strPath As Variant
Dim i As Integer
Dim fCount As Long

folder = "U:\Projects\Raw data\"
outputSheet = "Dataset"

    fCount = UBound(Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & folder & "*.*"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")) + 1

    'MsgBox Format(fCount, "#,00") & " files were found."



    If Dir(folder & "*.*") = "" Then
        MsgBox "The folder doesn't contain (visible) files"
        MsgBox "Bye Bye!!"
        Exit Sub
    Else
        'MsgBox "The folder does contain (visible) files"

        For i = 0 To 11
            fileName = folder & "Test" & i & ".txt"
                'If Dir(fileName) = "" Then     
            eRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

            With Sheets(outputSheet).QueryTables.Add(Connection:="TEXT;" + fileName, Destination:=Sheets(outputSheet).Range("$A$" + eRow))
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 850
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = True
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = True
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False

            End With

                    Dim wb_conection As WorkbookConnection
                    For Each wb_Connection In ActiveWorkbook.Connections
                    If InStr(fileName, wb_Connection.Name) > 0 Then
                    wb_Connection.Delete
                    End If
                    Next wb_Connection                
        Next i    
    End If

    MsgBox ("Done")
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...