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

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

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