Друзья, добрый день! Получаю по ADO данные из текстовых файлов. Автоматически создается файл schema.ini. Там в строчке "Format = TabDelimited" указываю желаемый разделитель. А как быть, если разделителя два или больше? В приложенном файле разделители табуляция и точка с запятой.
Пока может точку с запятой менять на табуляцию, привести к единому разделителю или есть более красивое решение.
Код
Код
Sub GetDataFromTxtFile(TxtFile As String)
'TxtConn - соединение с БД (в данном случае БД - текстовый файл)
'TxtRs - набор записей Recordset
Dim TxtConn As ADODB.Connection
Dim TxtRs As ADODB.Recordset
'DBPath - путь к БД
'ConnStr - строка подключения к БД
'LastRow - определение последней строки
Dim DBPath As String
Dim ConnStr As String
Dim LastRow As Long
DBPath = ThisWorkbook.Path
ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPath & ";Extended Properties='text;HDR=No;FMT=Delimited';"
Set TxtConn = New ADODB.Connection
Set TxtRs = New ADODB.Recordset
TxtConn.ConnectionString = ConnStr
TxtConn.Open
'закрыть соединение в случае ошибки
On Error GoTo CloseConnection
With TxtRs
.ActiveConnection = TxtConn
'SQL-запрос к БД
.Source = "SELECT * FROM " & "[" & TxtFile & "] " & ""
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
'закрыть Recordset в случае ошибки
On Error GoTo CloseRecordset
'последняя заполненная строка по столбцу "А"
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
'вставляем Recordset ниже последней заполненной строки
Range("A" & LastRow + 1).CopyFromRecordset TxtRs
'отключаем обработку ошибок
On Error GoTo 0
CloseRecordset:
TxtRs.Close
CloseConnection:
TxtConn.Close
End Sub
doober, ну да, он один, но задача еще и по точке запятой разделить. В рамках лишь указания разделителей в schema.ini нельзя так сделать? И как тогда это сделать красиво и лаконично.
На всякий случай, прикладываю весь код, которым эти манипуляции производятся. PQ не подходит, понимаю, что на нем это все гораздо проще. На картинке желаемый результат.
Код
Код
Option Explicit
Sub GetDataFromTxtFile(TxtFile As String)
'TxtConn - соединение с БД (в данном случае БД - текстовый файл)
'TxtRs - набор записей Recordset
Dim TxtConn As ADODB.Connection
Dim TxtRs As ADODB.Recordset
'DBPath - путь к БД
'ConnStr - строка подключения к БД
'LastRow - определение последней строки
Dim DBPath As String
Dim ConnStr As String
Dim LastRow As Long
DBPath = ThisWorkbook.Path
ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPath & ";Extended Properties='text;HDR=No;FMT=Delimited';"
Set TxtConn = New ADODB.Connection
Set TxtRs = New ADODB.Recordset
TxtConn.ConnectionString = ConnStr
TxtConn.Open
'закрыть соединение в случае ошибки
On Error GoTo CloseConnection
With TxtRs
.ActiveConnection = TxtConn
'SQL-запрос к БД
.Source = "SELECT * FROM " & "[" & TxtFile & "] " & ""
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
'закрыть Recordset в случае ошибки
On Error GoTo CloseRecordset
'последняя заполненная строка по столбцу "А"
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
'вставляем Recordset ниже последней заполненной строки
Range("A" & LastRow + 1).CopyFromRecordset TxtRs
'отключаем обработку ошибок
On Error GoTo 0
CloseRecordset:
TxtRs.Close
CloseConnection:
TxtConn.Close
End Sub
Sub GetArrayOfTxtFiles()
'If (Int(CDbl(Date)) - Int(CDbl(#7/31/2021#))) > 90 Then Exit Sub
' TxtFileName - имя обрабатываемого текстового файла
' TxtFiles - массив с именами найденных текстовых файлов
' FilesCount - счетчик кол-ва найденных текстовых файлов
' IsFileAdded - диапазон с именами ранее добавленных текстовых файлов
' для проверки на необходимость добавлять TxtFileName
' LastRow - последняя заполненная строка
' CheckList - лсит с именами ранее добавленных текстовых файлов
' i - счетчик
Dim TxtFileName As String
Dim TxtFiles() As String
Dim FilesCount As Integer
Dim IsFileAdded As Range
Dim LastRow As Long
Dim CheckList As Worksheet
Dim i As Integer
'отключаем обновление экрана, чтобы не мелькало и для быстродействия
Application.ScreenUpdating = False
Set CheckList = ThisWorkbook.Worksheets("Array")
FilesCount = 1
'Поиск всех текстовых файлов в папке
TxtFileName = Dir(ThisWorkbook.Path & "\" & "*.txt")
'цикл по всем текстовым файлам в папке
Do Until TxtFileName = ""
LastRow = CheckList.Cells(Rows.Count, 1).End(xlUp).Row
'просматриваем CheckList, есть ли там FileName
Set IsFileAdded = CheckList.Range("A1:A" & LastRow).Find(TxtFileName)
'Если отсутствует, то...
If IsFileAdded Is Nothing Then
'добавляем FileName в CheckList
CheckList.Range("A" & LastRow + 1).Value = TxtFileName
'Увеличиваем массив до номера последнего найденного файла,
' с сохранением предыдущих элементов
ReDim Preserve TxtFiles(1 To FilesCount)
'добавляем FileName в массив TxtFiles
TxtFiles(FilesCount) = TxtFileName
'Повторить поиcк с теми же аргументами
TxtFileName = Dir
FilesCount = FilesCount + 1
''Если найдено...
Else
FilesCount = FilesCount
TxtFileName = Dir
End If
Loop
''Если N = 1, значит новых файлов не найдено, добавлять нечего
If FilesCount = 1 Then MsgBox "Новых выписок не найдено": Exit Sub:
'создаем schema.ini на основе полученного массива с именами файлов
CreateSchemaIni (TxtFiles())
'снимает защиту с листа
ActiveSheet.Unprotect
'цикл по всем элементам полученного массивами
For i = 1 To FilesCount - 1
'статусбар для отслеживания прогресса
Application.StatusBar = "Выполнено: " & Int(100 * i / (FilesCount - 1)) & "%"
'чтобы форма перерисовывалась
DoEvents
'вызываем процедуру получения данных из текстового файла
GetDataFromTxtFile (TxtFiles(i))
Next i
'автоподбр ширины столбцов (пока что закомментировал, если надо вкл., то нужно раскомментировать)
'Range("A2").CurrentRegion.EntireColumn.AutoFit
'ставим автофильтр
Range("A1:H" & Cells(Rows.Count, 1).End(xlUp).Row).AutoFilter
'ставим защиту на лист с возможностью выделения ячеек и использования автофильтра
ActiveSheet.Protect AllowFiltering:=True
'удаляем schema.ini
DeleteSchemaIni
'очищаем статусбар
Application.StatusBar = False
'включаем обновление экрана
Application.ScreenUpdating = True
MsgBox "Обновлено"
End Sub
Sub CreateSchemaIni(TxtFiles As Variant)
Dim i As Integer
'открываем/создаем schema.ini
Open ThisWorkbook.Path & "\" & "schema.ini" For Output As #1
'для каждого файла в массиве с текстовыми фалами...
For i = LBound(TxtFiles) To UBound(TxtFiles)
'если имя фала содержит BIP, то кодировка будет 65001
If InStr(TxtFiles(i), "BIP") > 0 Then
Print #1, "[ " & TxtFiles(i) & "]" & vbNewLine & "ColNameHeader=False" & vbNewLine & _
"Format = TabDelimited" & vbNewLine & "TextDelimiter=None" & vbNewLine & "CharacterSet = 65001" & vbNewLine
'если не содержит BIP, то кодировка 1251
Else
Print #1, "[ " & TxtFiles(i) & "]" & vbNewLine & "ColNameHeader=False" & vbNewLine & _
"Format = TabDelimited" & vbNewLine & "TextDelimiter=None" & vbNewLine & "CharacterSet = 1251" & vbNewLine
End If
Next i
Close #1
End Sub
Sub DeleteSchemaIni()
Kill ThisWorkbook.Path & "\" & "schema.ini"
End Sub
Может на уровне SQL запроса делать замену точки с запятой на табуляцию? Только в нужном мне столбце (столбец О на скрине doober'a). Можно так?
Имеет ли смысл в таком случае читать через ADO? Считать просто в строку, разбить через SPLIT по переводу строки на записи. Записи на поля, только вот там куча TAB видимо для выравнивания, но это не проблема обработать. В нужном поле заменить ; на то что нужно.
Это же ведь сначала нужно выгрузить на лист, а потом разбивать по столбцам. Хотелось бы на лист выгрузить все готовое.
БМВ, как содержимое текстового файла получить в строку? Через ADO делал, просто чтобы разобраться, что такое это ADO и понравилось тем, что файлы бывают разные и достаточно лишь команду SQL поменять, чтобы работало со слегка видоизмененными файлами.
Импорт текста через использование объекта QueryTable (Меню / Данные / Из текста) позволяет задать одновременно несколько разделителей. Макрорекордер корректно записывает последовательность действий. Недостаток - неправильная работа в случае, если какие-то поля в записях содержат знак перевода строки (не Ваш случай). Объект QueryTable имеет продуманную систему свойств, в том числе для задания типов импортируемых полей, разделителей, кодировки файла и т.п.
Почему так получается? Chr(9) это же табуляция, а не пустота. При этом, если заменяю на, например, "!!!!!!!!!!!", то замена происходит корректно. Как-будто он заменяет на табуляцию, но потом не может эту табуляцию разбить по столбцам. И тупо убирает ее совсем. Посмотрите, пожалуйста, файл приложил к первому сообщению, положить текстовый в файл в одну папку с Excel-файлом.
Табуляция в ячейке видишь? А она есть! :-) Просто не отображается в ячейке, но оно там есть. проверьте, взяв один символ по номеру и посмотрите его код, или просто длину сравните. А что не пойти дальше и не сразу в запросе разделить на несколько полей.