MyTetra Share
Делитесь знаниями!
Access и текстовые файлы
16.03.2019
23:43
Текстовые метки: k_Спецификации,access, спецификации
Раздел: !Закладки - VBA - Access - Спецификации

Описание: В статье описываются различные методы, поддерживаемые Access для работы с текстовыми файлами, некоторые тонкости и возникающие проблемы.
Основное внимание уделено использованию файла спецификации Schema.ini вместо спецификаций Access, а также - методам прямого доступа из VBA, позволяющим получить информацию из нестандартных файлов или "причесать" их для последующего импорта.



Обсуждение статьи:  

Несколько дополнений, плюс UTF-8

Хочу внести некоторые дополнения...
1. Драйвер при чтении из файла воспринимает как разделитель строк не только vbCrLf, но и vbCr, и vbLf. И это радует . Но при записи в файл всегда используется vbCrLf.

2. Драйвер умеет работать с файлами в кодировке Unicode. Эта кодировка имеет несколько форматов, в частности: UTF-16LE (основной), UTF-16BE (старший байт в паре стоит первым), UTF-8. Каждый из этих форматов может иметь свой признак (Byte Order Mark или BOM). Это 2-3 байта с определенными значениями в начале файла. Его наличие желательно, т.к. однозначно указывает на формат текста в Unicode.
Указав "Юникод" в спецификации Access или CharacterSet=Unicode в файле Schema.ini, можно работать с файлами в формате UTF-16LE. В спецификации Access можно указать и другой формат ("Юникод (Big-Endian)" и "Юникод (UTF-8)"). В Schema.ini это выглядит так:

CharacterSet=Unicode или 1200 - UTF-16LE

CharacterSet=1201 - UTF-16BE

CharacterSet=65001 - UTF-8

Но здесь есть несколько замечаний:
а) При чтении из UTF-16LE драйвер "культурно" анализирует BOM и не включает его возвращаемые данные. При создании файла BOM добавляется.
В других форматах при создании файла BOM не добавляется, а при чтении включается в имя или значение первого поля.
б) Если в читаемом файле BOM отсутствует, то драйвер "думает", что это UTF-16LE (Блокнот, кстати - тоже). Это противоречит правилу в стандарте Unicode, что файл без BOM должен быть в формате UTF-16BE.

3. В статье, в примерах прямого доступа к файлам, наличие BOM не учтено. При создании файла без BOM внешняя программа может и не прочитать его, поэтому пример записи в файл желательно изменить:

'СОЗДАНИЕ ФАЙЛА С UNICODE

f = FreeFile: Open "C:\Файл U.txt" For Binary As f

'Преобразование строки в массив и запись массива выполняется "как есть".

bytArr = "Строка1" & vbCrLf & "Строка2" & vbCrLf & "Строка3" & vbCrLf

Put f, , CByte(&HFF)

Put f, , CByte(&HFE)

Put f, , bytArr

Close f

Вместо функции ReadTextFile предлагаю функцию, которая умеет читать файлы UTF-16LE, UTF-16BE и UTF-8, с BOM и без него. Также предлагаю функцию создания файла в UTF-8.

Function ReadAnyTextFile(sFilePath$, Optional fGetRowsArray As Boolean) As Variant

'Функция читает файлы в формате:

' Обычный (ANSI/OEM и т.п. с однобайтовой кодировкой)

' Unicode (UTF-16 LE, UTF-16 BE)

' UTF-8

'Формат файла определяется по маркеру BOM (первые 2-3 байта в начале файла)

' или анализом.

'Лишние завершающие символы vbCr и/или vbLf исключаются.

'Если fGetRowsArray=0, возвращает содержимое файла.

'Если fGetRowsArray=1, возвращает массив строк (разделитель vbCrLf, vbCr или vbLf).

On Error Resume Next

Dim i&, j&, k%, s$, arr() As Byte, iUtf8%, iUtf16%

i = FreeFile: Open sFilePath$ For Binary Access Read Shared As i

If Err.Number <> 0 Then Err.Clear: Exit Function

j = LOF(i): If j = 0 Then Close i: GoTo Finish

If j >= 4 Then

ReDim arr(1 To 4): Get i, , arr

'Проверяется наличие признака кодировки (первые 2-3 байта).

If arr(1) = &HFF And arr(2) = &HFE And arr(3) <> 0 Then

'Есть признак Unicode(UTF-16 LE). Читаем с 3-го байта.

k = 2: iUtf16 = 1

ElseIf arr(1) = &HFE And arr(2) = &HFF And arr(4) <> 0 Then

'Есть признак Unicode(UTF-16 BE). Читаем с 3-го байта.

k = 2: iUtf16 = 2

ElseIf arr(1) = &HEF And arr(2) = &HBB And arr(3) = &HBF Then

'Есть признак UTF-8. Читаем с 4-го байта.

k = 3: iUtf8 = 1

End If

End If

j = j - k: ReDim arr(1 To j): Get i, 1 + k, arr

Close i


If iUtf16 = 0 And iUtf8 = 0 And (UBound(arr) Mod 2) = 0 Then

'Проверка Unicode. Контролируется значение старшего байта в первом и последнем символе.

'Этого достаточно, если эти символы не "№" и не специальные знаки

' (например - математические или химические).

If arr(2) <= 5 And arr(UBound(arr)) <= 5 Then

iUtf16 = 1

ElseIf arr(1) <= 5 And arr(UBound(arr) - 1) <= 5 Then

iUtf16 = 2

End If

End If

If iUtf16 = 2 Then

'Для UTF-16 BE в цикле меняем местами парные байты.

For i = 1 To j - 1 Step 2

k = arr(i): arr(i) = arr(i + 1): arr(i + 1) = k

Next

End If

If iUtf16 > 0 Then s = arr: GoTo Finish


'Проверка UTF-8

For i = 1 To j - 1

Select Case arr(i)

Case Is <= 127

Case &HC2 To &HDF

'В UTF-8 после байта с таким кодом должен стоять байт с кодом &H80-&HBF

If arr(i + 1) < &H80 Or arr(i + 1) > &HBF Then iUtf8 = 0: Exit For

iUtf8 = 3: i = i + 1

Case &HE0 To &HFF

'В UTF-8 после байта с таким кодом должны стоять 2 байта с кодом &H80-&HBF

If i = j - 1 Then iUtf8 = False: Exit For

If arr(i + 1) < &H80 Or arr(i + 1) > &HBF Then iUtf8 = 0: Exit For

If arr(i + 2) < &H80 Or arr(i + 2) > &HBF Then iUtf8 = 0: Exit For

iUtf8 = 3: i = i + 2

Case Else

iUtf8 = 0: Exit For

End Select

Next

'Если в массиве найдены недопустимые для UTF-8 коды или все коды <=127

If iUtf8 < 3 Then s = StrConv(arr, vbUnicode): GoTo Finish


'Преобразование UTF-8 -> Unicode

For i = 1 To j

'Переменная "k" (код символа) - Integer (2 байта или 16 битов с весом 0-15)

Select Case arr(i)

Case Is <= 127

k = arr(i)

Case &HC2 To &HDF

'6 младших битов 2-го байта переносятся в код с тем же весом (0-5)

k = (arr(i + 1) And &H3F)

'5 младших битов 1-го байта переносятся в код с весом 6-10

k = k + (arr(i) And &H1F) * &H40 'Биты смещаются на 6 позиций влево.

i = i + 1

Case &HE0 To &HFF

'6 младших битов 3-го байта переносятся в код с тем же весом (0-5)

k = (arr(i + 2) And &H3F)

'6 младших битов 2-го байта переносятся в код с весом 6-11

k = k + (arr(i + 1) And &H1F) * &H40 'Биты смещаются на 6 позиций влево.

'4 младших бита 1-го байта переносятся в код с весом 12-15

k = k + (arr(i) And &HF) * &H1000 'Биты смещаются на 12 позиций влево.

i = i + 2

End Select

If k <= 127 Then s = s & Chr(k) Else s = s & ChrW(k)

Next


Finish:

'Исключаются лишние завершающие символы vbCr и/или vbLf

j = Len(s): Erase arr

For i = j To 1 Step -1

k = Asc(Mid$(s, i, 1))

If k <> 13 And k <> 10 Then Exit For

Next

If i < j Then s = Left(s, i)

If Not fGetRowsArray Then ReadAnyTextFile = s: Exit Function

If i <= 1 Then ReadAnyTextFile = Split(s): Exit Function

'Преобразование текста в массив строк.

If InStr(s, vbCrLf) > 0 Then

ReadAnyTextFile = Split(s, vbCrLf)

ElseIf InStr(s, vbLf) > 0 Then

ReadAnyTextFile = Split(s, vbLf)

Else

ReadAnyTextFile = Split(s, vbCr)

End If

End Function


Function CreateFileUTF8(strText As String, strFilePath As String, _

Optional fAppend As Boolean) As Boolean

'Функция создает или дополняет (fAppend=True) файл в формате UTF-8.

'В начало нового файла добавляется признак UTF-8 (3 байта).

'При успешном завершении возвращает True.

'Внимание! Функция не добавляет символ(ы) перевода строки. При необходимости

' они должны быть включены в передаваемый текст.

Dim i&, j&, k&, arr() As Byte

On Error GoTo Func_err

If Len(strText) = 0 Or Len(Trim$(strFilePath)) = 0 Then Exit Function

'Если fAppend=False и файл существует - удаляем.

If Not fAppend Then If Len(Dir$(strFilePath)) Then Kill strFilePath

'Создается массив с запасом 5% от длины текста

ReDim arr(1 To LenB(strText) * 1.05): i = 1

For j = 1 To Len(strText)

'Читаем код символа (Unicode).

k = AscW(Mid$(strText, j, 1))

'При необходимости увеличиваем размер массива

If (UBound(arr) - i) < 3 Then ReDim Preserve arr(1 To UBound(arr) * 1.05 + 3)

If k <= 127 Then

arr(i) = k: i = i + 1

ElseIf k > &H7FF Then

'Формируем значения трех байтов в UTF-8

arr(i) = (k And &HF000) / &H1000 'Биты 12-15 переносятся в биты 0-3 первого байта.

arr(i) = arr(i) Or &HE0 'Добавляется признак 1-го байта (биты 5-7)

arr(i + 1) = (k And &HFC0) / &H40 'Биты 6-11 -> биты 0-5 2-го байта

arr(i + 1) = arr(i + 1) Or &H80 'Добавляется признак 2-го байта (биты 6-7)

arr(i + 2) = (k And &H3F) 'Биты 0-5 -> биты 0-5 3-го байта

arr(i + 2) = arr(i + 2) Or &H80 'Добавляется признак 3-го байта (биты 6-7)

i = i + 3

Else

'Формируем значения двух байтов в UTF-8

arr(i) = (k And &H700) / &H40 'Биты 8-10 -> биты 2-4 1-го байта

arr(i) = arr(i) + (k And &HC0) / &H40 'Биты 6-7 -> биты 0-1 1-го байта

arr(i) = arr(i) Or &HC0 'Добавляется признак 1-го байта (биты 6-7)

arr(i + 1) = (k And &H3F) 'Биты 0-5 -> биты 0-5 2-го байта

arr(i + 1) = arr(i + 1) Or &H80 'Добавляется признак 2-го байта (биты 6-7)

i = i + 2

End If

Next j

'Убираем лишние элементы из массива

If i <= UBound(arr) Then ReDim Preserve arr(1 To i - 1)

'Открываем файл, вычисляем его размер

k = FreeFile: Open strFilePath For Binary As k: j = LOF(k)

If fAppend And j > 0 Then

'Если режим "Добавление" и файл не пустой - добавляем массив в конец файла

Put k, j + 1, arr

Else

'При создании нового файла добавляем массив, начиная с 4-й позиции

Put k, 4, arr

'В первые 3 байта пишем признак UTF-8 (BOM)

ReDim arr(1 To 3): arr(1) = &HEF: arr(2) = &HBB: arr(3) = &HBF

Put k, 1, arr

End If

'Закрываем файл.

Close k: CreateFileUTF8 = True

Func_exit:

Exit Function

Func_err:

MsgBox Err.Description, vbCritical, "Создание файла"

Resume Func_exit

End Function



14.04.2009 12:46


Еще несколько дополнений...

Анатолий (Киев)

  

На основании проведенных экспериментов хочу добавить следующее:
1. Утверждение, что спецификацию Access можно создать/редактировать/удалить только интерактивно - не совсем верно.
Да, системные таблицы MSysIMEXSpecs (общие параметры спецификаций) и MSysIMEXColumns (параметры полей) - только для чтения, но если в этой же БД создать связанные таблицы к этим системным таблицам, то редактировать спецификации можно! Но самую первую спецификацию надо создать "ручками", т.к. до этого указанные системные таблицы отсутствуют.

2. Серьезным недостатком спецификации в Schema.ini считается отсутствие параметра, указывающего символ - ограничитель текста или его отсутствие.
Из-за этого в экспортированном файле текстовые поля обрамляются кавычками, а кавычки внутри текста дублируются (это правило по умолчанию), а импорт файлов с текстовыми полями, не обрамленными кавычками, но имеющими кавычки в тексте приводит к искажению результата (потеря всего текста или части в таких полях и т.п.), а то и к ошибке импорта.
В официальной документации такой параметр не описывается, но на самом деле он есть и называется
TextDelimiter. Если указать TextDelimiter=None, то файл будет создан или прочитан правильно.
Вроде бы в Jet3.x значение None не работает, но для импорта можно указать любой символ, отсутствующий в тексте - эффект тот же.

3. Еще один недостаток использования Schema.ini - для каждого файла нужно создавать секцию. Оказывается, и это не так. Можно использовать одну секцию в качестве DSN, для чего в строке подключения запроса (или в св-ве "Extended Properties" создаваемого ADODB.Connection, или при вызове метода OpenDatabase (DAO)) указать "Text;
DSN=ИмяСекции".
Отмечу сразу, что в Access это не работает (он дальше своих спецификаций не видит), а, например, в Excel, VB, VBS – запросто.
Например, есть папка D:\Temp, в которой есть файлы Temp1.txt и Temp2.txt (без заголовков, без ограничителей текста с разделителем полей “#”, а также файл Schema.ini с секцией:
[TempSpec]
ColNameHeader=False
Format=Delimited(#)
TextDelimiter=None

В модуле Excel выполняем код, который читает оба файла и выкладывает на лист:

Set cnn = CreateObject(‘ADODB.Connection”)

Set rs = CreateObject(‘ADODB.Recordset”)

cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0"

cnn.Properties("Data Source") = "D:\Temp"

cnn.Properties("Extended Properties") = "Text;DSN=TempSpec"

cnn.Open


Set rs = cnn.Execute("SELECT * FROM [Temp1.txt];")

ActiveSheet.Range("A1").CopyFromRecordset rs


Set rs = cnn.Execute("SELECT * FROM [Temp2.txt];")

ActiveSheet.Range("A10").CopyFromRecordset rs

В модуле Excel выполняем код, который в D:\MyDB\db1.mdb импортирует файл Temp1.txt (создает таблицу Temp) и экспортирует в файл Temp3.txt имеющуюся таблицу:

Set cnn = CreateObject(‘ADODB.Connection”)

cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0"

cnn.Properties("Data Source") = "D:\MyDB\db1.mdb"

cnn.Open

s = "SELECT * INTO Temp FROM [Temp1.txt] IN 'D:\Temp' [Text;DSN=TempSpec];"

cnn.Execute s


s = "SELECT * INTO [Temp3.txt] IN ' D:\Temp' [Text; DSN=TempSpec] FROM Table1;"

cnn.Execute s


16.02.2012 15:07

 
MyTetra Share v.0.52
Яндекс индекс цитирования