Текстовые Файлы - Экспорт данных с Перекодировкой

Автор: Анатолий Кривцов

    Кто пробовал выполнить экспорт в текстовый файл, знает, что экспортировать можно только данные из таблицы или запроса, не имеющего параметров или ссылок на элементы форм. Проблема решается созданием файла непосредственно в процедуре. Идея принадлежит Фаине Крамаровской. Предлагаемая процедура создает файл C:\WarePrice.txt в формате "Переменной длинны с разделителями".Первая строка - имена полей, разделители полей -"#", кодировка символов - DOS (функция ConvANSItoOEM). Такой метод работает быстрее, чем стандартный, и позволяет за один проход создать два и более файлов (например для экспорта в таблицы на стороне "один" и "многие").

Пример:

Private Sub EksportWarePrice()

Dim dbs As Database, qdf As QueryDef, rst As Recordset, NameFld As String

'--------------------------------------------------------------------

Set dbs = CurrentDb

Set qdf = dbs.CreateQueryDef("")

qdf.SQL = "Parameters .... Select ..."

qdf.Parameters("Имя параметра") = "Значение"

Set rst = qdf.OpenRecordset

If rst.BOF Then

Exit Sub

End If

Open "C:\WarePrice.txt" For Output As #1

NameFld = "WareID#WareName#Price"

Print #1, NameFld

With rst

Do Until .EOF

Print #1, ![WareID] & "#" _

& ConvANSItoOEM(![WareName]) & "#" _

& Format(![Price], "#.00")

.MoveNext

Loop

End With

Close #1

End Sub

Еще пример (попроще):

Private Sub EksportWareEasy()

Dim rst As DAO.Recordset

Set rst = CurrentDb.OpenRecordset("tblExample", dbOpenDynaset)

Open "D:\Temp\WarePrice.txt" For Output As #1

With rst

Do Until .EOF

Print #1, !exRecordID & "#" _

& ConvANSItoOEM(!exName) & "#" _

& Format(!exRecordID, "#.00")

.MoveNext

Loop

End With

Close #1

End Sub

Перекодировка:

Public Function ConvANSItoOEM(strText, _

Optional boolUkrStandard As Boolean) As String

' Перекодировка строки из Windows в Dos.

' По умолчанию перекодировка в 866 таблицу. Если установлен

' флажок boolUkrStandard - украинские символы по стандарту.

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

'--------------------------------------------------------------------

Dim Arr() As Byte, i As Integer, strOut As String, _

intLB As Integer, intUB As Integer

If strText = "" Then

Exit Function

End If

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

Arr() = StrConv(strText, vbFromUnicode)

intLB = LBound(Arr)

intUB = UBound(Arr)

For i = intLB To intUB

Select Case Arr(i)

Case Is < 161

Case 185 ' №

Arr(i) = 252

Case 192 To 239 ' от "А" до "п"

Arr(i) = Arr(i) - 64

Case 240 To 255 ' от "р" до "я"

Arr(i) = Arr(i) - 16

Case 168 ' Ё

Arr(i) = 240

Case 184 ' ё

Arr(i) = 241

Case 178 ' І

Arr(i) = IIf(boolUkrStandard, 246, 73)

Case 179 ' і

Arr(i) = IIf(boolUkrStandard, 247, 105)

Case 170 ' Є

Arr(i) = IIf(boolUkrStandard, 244, 242)

Case 186 ' є

Arr(i) = IIf(boolUkrStandard, 245, 243)

Case 175 ' Ї

Arr(i) = IIf(boolUkrStandard, 248, 244)

Case 191 ' ї

Arr(i) = IIf(boolUkrStandard, 249, 245)

Case 161 ' Ў

Arr(i) = 246

Case 162 ' ў

Arr(i) = 247

End Select

Next i

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

ConvANSItoOEM = StrConv(Arr(), vbUnicode)

End Function