Форумы HiProg.com - MS ACCESS, VBA, VB

ник: ДрЮня
Вот нарыл, попробуйте

Option Explicit Private Const rFrom As Long = 11 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 Private 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