RIALAB.

Visual Basic 6(以下VB6)では、標準コントロールを用いてUnicode文字列を表示しようとすると文字化けを起こしてしまい正しく表示することができません。
表示に関しては、マイクロソフトのサポート情報「[HOWTO] Visual Basic のフォームで UNICODE 文字列の読み込みと表示を行う方法」で紹介されているように、Forms 2.0コントロールを使うことで正しくUnicode文字列の表示が行えるようになります。
しかし、Forms 2.0コントロールではユーザが入力した内容を正しく取得することができず、テキストボックスを用いて入力値を取得すると文字化けを起こしてしまいます。

いろいろと試していくと、TextプロパティやClipboardオブジェクトなど、VB6が持っている機能に触れそうな処理を通過してしまうと文字化けを起こしてしまうようだということがわかりました。
これを回避するため、APIを使いクリップボードに入力された文字列を変数にコピーし、ADO Streamを使い文字コードの変換を行っています。
細やかな制御が求められる場面では、タイミングが合わず意図しない文字列を取得してしまう可能性もありますが、使用場面に応じてアレンジしてみてください。 
なお、動作確認はWindows 7 32bit版で行っています。 
 

Option Explicit
'============================================================================
' Win32関連の宣言と定義
'============================================================================
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long

Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Public Const GMEM_MOVABLE = &H2
Public Const CF_UNICODETEXT = 13

Public Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal destination As Long, ByVal source As Long, ByVal Length As Long)

Public Type KEYBDINPUT
    wVk         As Integer
    wScan       As Integer
    dwFlags     As Long
    time        As Long
    dwExtraInfo As Long
    no_use1     As Long
    no_use2     As Long
End Type
Public Type INPUT_TYPE
    dwType      As Long
    xi          As KEYBDINPUT
End Type

Public Const KEYEVENTF_KEYUP = &H2
Public Const KEYEVENTF_EXTENDKEY = &H1
Public Const VK_CTRL = &H11
Public Const VK_C = &H43
Public Const VK_V = &H56
Public Const INPUT_KEYBOARD = 1

Public Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Public Declare Function SendInput Lib "user32" (ByVal nInputs As Long, pInputs As INPUT_TYPE, ByVal cbsize As Long) As Long

'============================================================================
' - 機能 -
'  textboxに入力されたUNICODE文字列を取得する
'
' - 引数 -
'
'    textbox    Forms 2.0のテキストボックス
'
' - 返り値 -
'    textboxに入力された内容
'
'============================================================================
Public Function GetUnicodeText(ByRef textbox As Control) As String
Dim pInput As INPUT_TYPE
Dim data() As Byte
Dim wFormat As Long
Dim hMem As Long
Dim Size As Long
Dim p As Long
Dim oStream As Object
    
    '-
    ' 対象となるコントロールにフォーカスを移動
    '-
    textbox.SetFocus
    textbox.SelStart = 0
    textbox.SelLength = Len(textbox.Text)
    DoEvents

    '-
    ' API経由でCtrl+C相当の操作
    '-
    pInput.dwType = INPUT_KEYBOARD
    With pInput.xi
        .wVk = VK_CTRL
        .wScan = MapVirtualKey(VK_CTRL, 0)
        .dwFlags = KEYEVENTF_EXTENDKEY Or 0
        .time = 0
        .dwExtraInfo = 0
    End With
    SendInput 1, pInput, Len(pInput)
    DoEvents
    
    pInput.dwType = INPUT_KEYBOARD
    With pInput.xi
        .wVk = VK_C
        .wScan = MapVirtualKey(VK_C, 0)
        .dwFlags = KEYEVENTF_EXTENDKEY Or 0
        .time = 0
        .dwExtraInfo = 0
    End With
    SendInput 1, pInput, Len(pInput)
    DoEvents
    
    pInput.dwType = INPUT_KEYBOARD
    With pInput.xi
        .wVk = VK_C
        .wScan = MapVirtualKey(VK_C, 0)
        .dwFlags = KEYEVENTF_EXTENDKEY Or KEYEVENTF_KEYUP
        .time = 0
        .dwExtraInfo = 0
    End With
    SendInput 1, pInput, Len(pInput)
    DoEvents
    
    pInput.dwType = INPUT_KEYBOARD
    With pInput.xi
        .wVk = VK_CTRL
        .wScan = MapVirtualKey(VK_CTRL, 0)
        .dwFlags = KEYEVENTF_EXTENDKEY Or KEYEVENTF_KEYUP
        .time = 0
        .dwExtraInfo = 0
    End With
    SendInput 1, pInput, Len(pInput)
    DoEvents
    
    '-
    ' クリップボードの内容をAPI経由で変数にコピー
    '-
    If OpenClipboard(ByVal 0&) Then
        hMem = GetClipboardData(CF_UNICODETEXT)
        If hMem Then
            Size = GlobalSize(hMem)
            p = GlobalLock(hMem)
            ReDim data(0 To Size)
            MoveMemory VarPtr(data(0)), p, Size
            GlobalUnlock hMem
        End If
        CloseClipboard
    End If

    '-
    ' ADOストリームで文字コードを変換
    '-
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Type = 1   ' 1:adTypeBinary
    oStream.Open
    oStream.Write data
    oStream.Position = 0
    oStream.Type = 2   ' 2:adTypeText
    
    GetUnicodeText = oStream.ReadText(-1)
    
    oStream.Close
    
    Set oStream = Nothing
    
End Function