У меня есть папка, которая будет заполняться файлами с общими символами, но с разницей в одну цифру, т. Е. Тест 34 или тест 40. Папка может быть пустой или содержать 50 файлов.
Iпытаюсь написать код, который может:
- перейти к проверке папки, если папка пуста, если нет
- взять каждый текстовый файл и импортировать данные с разделителями-пробелами в Excel (в идеале на основедата изменения файла в папке - пока не получилось.)
- Переместить файлы в папку архива (может вызвать проблемы, если имя файла уже существует в архиве)
- , если папка пуста,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