Rambler's Top100
Форум: MS ACCESSVBVBA MS OfficeMS SQL server
Новые сообщения: 0000

Форум: MS ACCESS

Вопросы связанные с MS ACCESS

Обновить визитку
Участники «Online»
Все участники

 
 

Доброго времени суток, Посетитель!

вид форума:
Линейный форум Структурный форум

тема: Вывод текстового файла в кодировке UTF-8
 
 автор: Vik   (12.03.2008 в 20:27)   личное сообщение
 
 

Вывожу с помощью VBA через FileSystemObject текстовый файл - XML.

Посоветуйте, каким образом сделать кодировку выводимых данных UTF-8?

Заранее благодарен.

  Ответить  
 
 автор: ДрЮня   (12.03.2008 в 22:38)   личное сообщение
 
 

есть такой вот модуль - попробуйте разобраться


Option Explicit

Private Const CP_ACP As Long = 0                        'default to ANSI code page
Private Const CP_OEMCP As Long = 1                      'default to OEM  code page
Private Const CP_MACCP As Long = 2                      'default to MAC  code page
Private Const CP_THREAD_ACP As Long = 3                 'current thread's ANSI code page
Private Const CP_SYMBOL As Long = 42                   'SYMBOL translations
Private Const CP_UTF7 As Long = 65000                  'UTF-7 translation
Private Const CP_UTF8 As Long = 65001                  'UTF-8 translation

Public Declare Function MultiByteToWideChar& Lib "kernel32" (ByVal CodePage As Long, _
            ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, _
            ByRef buff As Byte, ByVal cchWideChar As Long)

Public Declare Function WideCharToMultiByte& Lib "kernel32" (ByVal CodePage As Long, _
            ByVal dwFlags As Long, ByRef buff As Byte, ByVal cchWideChar As Long, _
            ByRef buffCoded As Byte, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, _
            ByVal lpUsedDefaultChar As Long)



Public Function cpCODE(sCodePage As String, sANSI As String) As String
Dim s As String, _
    bb(1023) As Byte, _
    bbCod(1023) As Byte, _
    lngBadSymbols As Long, _
    res As Long, _
    lngBuffSize As Long, _
    lngCP As Long

    On Error GoTo L_Err
    
    If sANSI = "" Then cpCODE = "": Exit Function
    Select Case sCodePage
        Case "CP_ACP": lngCP = 0
        Case "CP_OEMCP": lngCP = 1              'default to OEM  code page"
        Case "CP_MACCP": lngCP = 2              'default to MAC  code page"
        Case "CP_THREAD_ACP": lngCP = 3         'current thread's ANSI code page"
        Case "CP_SYMBOL": lngCP = 42            'SYMBOL translations"
        Case "CP_UTF7": lngCP = 65000           'UTF-7 translation"
        Case "CP_UTF8": lngCP = 65001           'UTF-8 translation"
        Case Else
            cpCODE = "Set Code Page not define"
            Exit Function
    End Select
    
    'преобразуем ascii строчку в unicode
        res = MultiByteToWideChar(CP_ACP, 0, sANSI, -1, bb(0), 512)
        If res = 0 Then
            cpCODE = "Function 'MultiByteToWideChar' return ERROR"
            Exit Function
        End If
        
    'определяем размер выходного буфера
        lngBuffSize = WideCharToMultiByte(lngCP, 0, bb(0), -1, bbCod(0), 0, vbNullString, lngBadSymbols)
    
    'конвертируем данные входного буфера в заданную кодовую страницу и помещаем в выходной буфер
        res = WideCharToMultiByte(lngCP, 0, bb(0), -1, bbCod(0), lngBuffSize, vbNullString, lngBadSymbols)
        
    'преобразуем выходной буфер в строку в заданной кодовой странице
        Call BinToStr(bbCod(), 0, lngBuffSize - 1, cpCODE)
    
L_Exit:
    Exit Function
   
L_Err:
    cpCODE = Err.Description & " (" & Err.Number & ")"
    GoTo L_Exit
End Function

  Ответить  
 
 автор: Vik   (13.03.2008 в 19:11)   личное сообщение
 
 

Спасибо, попробую.
О результатах обязательно сообщу.

  Ответить  
 
 автор: Vik   (15.07.2008 в 21:36)   личное сообщение
 
 

Матерится на BinToStr

Подскажите, как лечить сию болезнь?

  Ответить  
 
 автор: ДрЮня   (16.07.2008 в 09:30)   личное сообщение
 
 


Public Sub BinToStr(bb() As Byte, off As Long, num As Long, str As String)
Dim lng As Long

  For lng = off To off + num - 1
      str = str + Chr(bb(lng))
  Next lng
End Sub

  Ответить  
 
 автор: Vik   (16.07.2008 в 20:38)   личное сообщение
 
 

Все получилось, большое СПАСИБО!

Будете во Львове - с меня пиво!

  Ответить  
 
 автор: дрюня   (16.07.2008 в 21:51)   личное сообщение
 
 

ну как говорится, никто за язык не тянул ;)
успехов нам всем :)

  Ответить  
HiProg.com - Технологии программирования
Rambler's Top100 TopList