MyTetra Share
Делитесь знаниями!
Текстовые Файлы - Экспорт данных с Перекодировкой
Время создания: 16.03.2019 23:43
Раздел: !Закладки - VBA - Access - msa.polarcom.ru - 11 Импорт - Экспорт
Запись: xintrea/mytetra_db_adgaver_new/master/base/1532017787fzj88aepny/text.html на raw.githubusercontent.com

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

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


    Кто пробовал выполнить экспорт в текстовый файл, знает, что экспортировать можно только данные из таблицы или запроса, не имеющего параметров или ссылок на элементы форм. Проблема решается созданием файла непосредственно в процедуре. Идея принадлежит Фаине Крамаровской. Предлагаемая процедура создает файл 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




Так же в этом разделе:
 
MyTetra Share v.0.59
Яндекс индекс цитирования