[RESOLVED] How-to read unicode characters from windows clipboard

[vb.elmar]

Hello,
the text string below contains Greek (or Cyrillic) characters

thе brοwn fοх ϳumрѕ οvеr а Ӏаzу bаg

when I copy the text to the windows clipboard
and paste it (Ctrl+V) into the Forms 2.0 Textbox (Textbox1),
the Asc codes "116, 104, 1077" are shown.


This is the code:

Private Sub Form_Load()
'    TextBox1.Text = Clipboard.GetText
    Form1.AutoRedraw = True 'draw to form
    Form1.WindowState = 2 'show form1 maximized
End Sub

Private Sub TextBox1_Change()
cb = Clipboard.GetText
    For r = 1 To Len(cb)
        x = Mid(TextBox1.Text, r, 1)
        y = AscW(x)
        Form1.Print " "; (y)
    Next
End Sub

But when I use the code:

Private Sub Form_Load()
    TextBox1.Text = Clipboard.GetText
    Form1.AutoRedraw = True 'draw to form
    Form1.WindowState = 2 'show form1 maximized
End Sub

the (wrong) Asc codes "116, 104, 63" are shown.

How is it possible to display the Asc codes "116, 104, 1077"
when using the clipboard (without having a textbox on Form1)?

-Do I need the StrPtr() function?

[DrUnicode]

Vb6 Clipboard.GetText does not support Unicode.
See http://www.vbaccelerator.com/home/VB...e/article.html
Use Format 13 = Text(Unicode)

[vb.elmar]

Let's assume the variable "s" is containing the text
with the Greek (or Cyrillic) characters.

Would it be possible to display the Asc codes
"116, 104, 1077" by using ...

For r = 1 To Len(s)
x = Mid(s, r, 1)
y = AscW(x)
Form1.Print y
Next

??

-How must I change the code
without having a textbox on Form1 ?

[fafalone]

Don't really need the whole VBAccelerator setup...

Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Public Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr 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 CloseClipboard Lib "user32" () As Long
Private Const CF_UNICODETEXT = 13

Public Function ClipboardGetText() As String
    Dim hGlobal As Long
        
        If OpenClipboard(0) Then
            hGlobal = GetClipboardData(CF_UNICODETEXT)
            
            If hGlobal Then
                SysReAllocString VarPtr(ClipboardGetText), GlobalLock(hGlobal)
                 hGlobal = GlobalUnlock(hGlobal)
                hGlobal = CloseClipboard
            End If
        End If
End Function

[vb.elmar]

Your solution works. -Thanks fafalone.

Paste the code below in a form:

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Const CF_UNICODETEXT = 13

Private Function ClipboardGetText() As String
    Dim hGlobal As Long
    If OpenClipboard(0) Then
        hGlobal = GetClipboardData(CF_UNICODETEXT)
            If hGlobal Then
                SysReAllocString VarPtr(ClipboardGetText), _
                          GlobalLock(hGlobal)
                hGlobal = GlobalUnlock(hGlobal)
                hGlobal = CloseClipboard
            End If
    End If
End Function

Private Sub Form_Load()
    Form1.AutoRedraw = True 'draw to form1
    Form1.WindowState = 2 'show form1 maximized

    Dim s As String, r As Long, x As String * 1, y As Long
    s = ClipboardGetText
    
    For r = 1 To Len(s)
        x = Mid(s, r, 1)
        y = AscW(x)
        Form1.Print y
    Next
End Sub

[Elroy]

Here's my code to do it (a write unicode to clipboard is also provided):

Option Explicit
'
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Function GlobalSize Lib "kernel32.dll" (ByVal hMem As Long) As Long
'

Public Property Let UniClipboard(sUniText As String)
    ' Puts a VB string in the clipboard without converting it to ASCII.
    Dim iStrPtr As Long
    Dim iLen As Long
    Dim iLock As Long
    Const GMEM_MOVEABLE As Long = &H2
    Const GMEM_ZEROINIT As Long = &H40
    Const CF_UNICODETEXT As Long = &HD
    '
    OpenClipboard 0&
    EmptyClipboard
    iLen = LenB(sUniText) + 2&
    iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
    iLock = GlobalLock(iStrPtr)
    lstrcpy iLock, StrPtr(sUniText)
    GlobalUnlock iStrPtr
    SetClipboardData CF_UNICODETEXT, iStrPtr
    CloseClipboard
End Property

Public Property Get UniClipboard() As String
    ' Gets a UNICODE string from the clipboard and puts it in a standard VB string (which is UNICODE).
    Dim iStrPtr As Long
    Dim iLen As Long
    Dim iLock As Long
    Dim sUniText As String
    Const CF_UNICODETEXT As Long = 13&
    '
    OpenClipboard 0&
    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
        iStrPtr = GetClipboardData(CF_UNICODETEXT)
        If iStrPtr Then
            iLock = GlobalLock(iStrPtr)
            iLen = GlobalSize(iStrPtr)
            sUniText = String$(iLen \ 2& - 1&, vbNullChar)
            lstrcpy StrPtr(sUniText), iLock
            GlobalUnlock iStrPtr
        End If
        UniClipboard = sUniText
    End If
    CloseClipboard
End Property

[vb.elmar]

@Elroy
can you please edit your post and add the GlobalSize function (because the GlobalSize function was omitted) :

Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long

[Elroy]

Ahhh, sorry about that. I cut that code out of a module that had much more in it. I thought I got all of the API declarations, but I obviously missed one.

It's fixed now (in post #6).

[Bonnie West]

Here's yet another Unicode-aware Clipboard module that's modeled after the intrinsic Clipboard object. It exposes additional system Clipboard functionality, including the ability to monitor Clipboard content changes.

[Elroy]

WOW Bonnie, quite the project.

Is the ClipboardW.cls module your code? If so, it states in the header that GetData and SetData aren't implemented. Why don't you just use VB6's standard Clipboard object to do this, and just write pass-through procedures in the CLipboardW.cls class? Or maybe you would just really like to do it with API calls.

Regards,
Elroy

[Bonnie West]

Is the ClipboardW.cls module your code?

Yeah.

If so, it states in the header that GetData and SetData aren't implemented. Why don't you just use VB6's standard Clipboard object to do this, and just write pass-through procedures in the CLipboardW.cls class? Or maybe you would just really like to do it with API calls.

Delegating those methods to the corresponding methods of the intrinsic Clipboard object would be like cheating. I prefer to learn how to implement those methods the hard way.

[Jonney]

VBAccelerator has a good Clipboard class.
@Bonnie West :Use ChrW$ for Unicode

TextBoxW1.SelText = (sChar & "   ") & _
                            (ChrW$(Asc(sChar)) & _
                             Right$("       " & AscW(sChar), 7&)) & _
                            (Right$("      &H" & Hex$(AscW(sChar)), 8&) & vbNewLine)

[Bonnie West]

@Bonnie West :Use ChrW$ for Unicode

Yeah, thanks for the reminder!

[wqweto]

`OpenClipboard` might fail on concurrent access -- Remote Desktop Client is particularly annoying

Here is a retrying version, based on vbAccelerator code:

Public Function ClipboardOpen(ByVal hWndOwner As Long) As Boolean
    Dim lR          As Long
    Dim lRetry      As Long

    ClipboardClose
    For lRetry = 1 To 5
        lR = OpenClipboard(hWndOwner)
        If lR <> 0 Then
            m_hWnd = hWndOwner
            m_bClipboardIsOpen = True
            '--- success
            ClipboardOpen = True
            Exit Function
        End If
        Call Sleep(Rnd() * 500)
    Next
End Function

(Note: Make sure to call `Randomize` somewhere on process startup)

cheers,
</wqw>

[Jonney]

`OpenClipboard` might fail on concurrent access -- Remote Desktop Client is particularly annoying

Here is a retrying version, based on vbAccelerator code:

Public Function ClipboardOpen(ByVal hWndOwner As Long) As Boolean
    Dim lR          As Long
    Dim lRetry      As Long

    ClipboardClose
    For lRetry = 1 To 5
        lR = OpenClipboard(hWndOwner)
        If lR <> 0 Then
            m_hWnd = hWndOwner
            m_bClipboardIsOpen = True
            '--- success
            ClipboardOpen = True
            Exit Function
        End If
        Call Sleep(Rnd() * 500)
    Next
End Function

(Note: Make sure to call `Randomize` somewhere on process startup)

cheers,
</wqw>

You found a bug in original code:

If (lR > 0) Then  'MSDN:If the function succeeds, the return value is nonzero.

Can I use Randomize before Call Sleep?

Randomize
Call Sleep(Rnd() * 500) 'Note: Make sure to call `Randomize` somewhere on process startup

[wqweto]

@Jonney: `Randomize` is seeding the PRNG, this is a one-time operation.

Check-out this thread for documentation snippets: http://www.vbforums.com/showthread.p...B6-and-earlier

cheers,
</wqw>

[fafalone]

Why sleeping random times anyway?

[Jonney]

@Jonney: `Randomize` is seeding the PRNG, this is a one-time operation.

Check-out this thread for documentation snippets: http://www.vbforums.com/showthread.p...B6-and-earlier

cheers,
</wqw>

Nice snippet. Thanks.

If lRetry = 1 Then Randomize 'Just once to ensure that we get random values
Call Sleep(Rnd() * 500) 'Note: Make sure to call `Randomize` somewhere on process startup

[dilettante]

`OpenClipboard` might fail on concurrent access -- Remote Desktop Client is particularly annoying

It is supposed to fail, as documented on MSDN. I'm not convinced hammering on it makes sense.

[wqweto]

It's a viable option, provided that .Net `Clipboard` class even has `retryTimes` and `retryDelay` as parameters to `SetDataObject` method -- https://msdn.microsoft.com/en-us/library/ms158293.aspx

FWIW, vbAccelerator's error handling on `SetClipboardData` does leak `hMem` on failure, i.e. on success the OS takes care freeing the global, but on failure it's solely caller responsibility to `GlobalFree` the `hMem`.

cheers,
</wqw>

[Jonney]

It's a viable option, provided that .Net `Clipboard` class even has `retryTimes` and `retryDelay` as parameters to `SetDataObject` method -- https://msdn.microsoft.com/en-us/library/ms158293.aspx

FWIW, vbAccelerator's error handling on `SetClipboardData` does leak `hMem` on failure, i.e. on success the OS takes care freeing the global, but on failure it's solely caller responsibility to `GlobalFree` the `hMem`.

cheers,
</wqw>

Public Function SetBinaryData( _
        ByVal lFormatId As Long, _
        ByRef bData() As Byte _
    ) As Boolean
' Puts the binary data contained in bData() onto the clipboard under
' format lFormatID:
Dim lSize As Long
Dim lPtr As Long
Dim hMem As Long

    If pbNotReady() Then Exit Function
    
    ' Determine the size of the binary data to write:
    lSize = UBound(bData) - LBound(bData) + 1
    ' Generate global memory to hold this:
    hMem = GlobalAlloc(GMEM_DDESHARE, lSize)
    If (hMem <> 0) Then
        ' Get pointer to the memory block:
        lPtr = GlobalLock(hMem)
        ' Copy the data into the memory block:
        CopyMemory ByVal lPtr, bData(LBound(bData)), lSize
        ' Unlock the memory block.
        GlobalUnlock hMem
                
        ' Now set the clipboard data:
        If (SetClipboardData(lFormatId, hMem) <> 0) Then
            ' Success:
            SetBinaryData = True
        Else
           GlobalFree hMem  'On failure,caller responsibility to `GlobalFree` the `hMem`
        End If
    End If
    ' We don't free the memory because the clipboard takes
    ' care of that now.

End Function

[mhd_jamil]

Richtext can be used to catch the unicode clipboard, usually unicode from clipboard is utf or codepage

If we can read the clipboard content (unicode data), and we confident that it were utf, we can put one by one unicode character with this methode:

RichTextBox1.SelRTF = "{\deff0{\fonttbl{\f0\fcharset128}}\u12431 }" 'Japanese わ hex 308F

and for CodePage:

RichTextBox1.SelRTF = "{\deff0{\fonttbl{\f0\fcharset128}}\'82\'ed }" 'Japanese わ

'use richtext is nice if nothing else will be used

Private Sub Command1_Click()
      RichTextBox1.TextRTF = "{\deff0{\fonttbl{\f0}}\fcharset128\'82\'ed }"
      Debug.Print RichTextBox1.TextRTF
      RichTextBox1.TextRTF = "{\deff0{\fonttbl{\f0\fcharset128}}\u12431 }"
      Debug.Print RichTextBox1.TextRTF
      
      RichTextBox1.TextRTF = "{\fcharset128\u12431}" '==>change to \'82\'ed
      Debug.Print RichTextBox1.TextRTF
      RichTextBox1.TextRTF = "{\deff0{\fonttbl{\f0}}\fcharset128\'82\'ed }" 'Change To \u12431
      Debug.Print RichTextBox1.TextRTF
      
      RichTextBox1.SelRTF = "{\deff0{\fonttbl{\f0}}\fcharset128\'82\'ed }"
      RichTextBox1.SelRTF = "{\fcharset128\fs34\u12431}"
      RichTextBox1.SelRTF = "{\fcharset128\fs25\u12431}"
      RichTextBox1.SelRTF = "{\fcharset128\u12431}"
      RichTextBox1.SelRTF = "{\deff0{\fonttbl{\f0\fcharset128}}\u12431 }"
      RichTextBox1.SelRTF = "{\fcharset128\u12431}"
      RichTextBox1.SelRTF = "{\deff0{\fonttbl{\f0\fcharset128}}\u12431 }"
      Debug.Print RichTextBox1.TextRTF
End Sub

[mhd_jamil]

To Copy and paste the unicode text from web, rtf, doc and other to rtf, but i have not tested more, please comment if any error or suggestion.

Code in Form:

Option Explicit

Private WithEvents objWeb As VBControlExtender
Private web1 As Object

Private Sub Command2_Click()
End Sub

Private Sub btnCopy_Click()
    Clipboard.Clear
    Clipboard.SetText RichTextBox1.SelRTF, vbCFRTF
    objWeb.Visible = True
    web1.Document.body.contentEditable = True
    web1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
    web1.ExecWB OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT
    web1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
    web1.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
    web1.ExecWB OLECMDID_CUT, OLECMDEXECOPT_DODEFAULT
    objWeb.Visible = False

End Sub

Private Sub Form_Click()
       ControlSelectAll RichTextBox1.hwnd
End Sub

Private Sub Form_Load()
    Dim i As Long

    Set objWeb = Controls.Add("Shell.Explorer.2", "web1", Me)
    objWeb.Visible = False
    objWeb.Left = -1000
    Set web1 = objWeb.object
    With web1
        .Offline = True
        .Silent = True
        .RegisterAsBrowser = False
        .RegisterAsDropTarget = False
        .MenuBar = False
        .ToolBar = 0
        .Navigate "about:blank"
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
   If Not web1 Is Nothing Then
     Set web1 = Nothing
   End If
End Sub

Private Sub Paste_Click()
    objWeb.Visible = True
    web1.Document.body.contentEditable = True
    web1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
    web1.ExecWB OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT
    web1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
    web1.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
    ControlPaste RichTextBox1.hwnd
    web1.ExecWB OLECMDID_CUT, OLECMDEXECOPT_DODEFAULT
    objWeb.Visible = False
End Sub

In Module:

Public Const OLECMDID_SELECTALL = 17 '(&H11)
Public Const OLECMDID_COPY = 12
Public Const OLECMDID_CUT = 11
Public Const OLECMDID_PASTE = 13
Public Const OLECMDEXECOPT_DODEFAULT = 0

Private Const WM_CUT = &H300
Private Const WM_COPY = &H301
Private Const WM_PASTE = &H302
Private Const WM_CLEAR = &H303
Private Const WM_SELECTALL = &HB1
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal _
    hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    lParam As Any) As Long

' Copy the contents of a control into the Clipboard
Sub ControlCopy(ByVal hwnd As Long)
    SendMessage hwnd, WM_COPY, 0, ByVal 0&
End Sub

' Cut the contents of a control into the Clipboard
Sub ControlCut(ByVal hwnd As Long)
    SendMessage hwnd, WM_CUT, 0, ByVal 0&
End Sub

' Paste the contents of the Clipboard into a control
Sub ControlPaste(ByVal hwnd As Long)
    SendMessage hwnd, WM_PASTE, 0, ByVal 0&
End Sub

' Delete the selected contents of a control
Sub ControlDelete(ByVal hwnd As Long)
    SendMessage hwnd, WM_CLEAR, 0, ByVal 0&
End Sub

Sub ControlSelectAll(ByVal hwnd As Long)
    SendMessage hwnd, WM_SELECTALL, ByVal 0&, ByVal 0&
End Sub

[Bonnie West]

Private Const WM_SELECTALL = &HB1

Sub ControlSelectAll(ByVal hwnd As Long)
    SendMessage hwnd, WM_SELECTALL, ByVal 0&, ByVal 0&
End Sub

For those who are wondering about the WM_SELECTALL constant, its official name is actually EM_SETSEL. According to its documentation, if one wants to select all text in the control, one should pass 0 to wParam and -1 to lParam.

[mhd_jamil]

Thanks Bonnie West for the correction, i don't use it because it doesn't work for me, and after i got your information and I test again that function, it work perfectly so I modify the code for advance to take the unicode byte, but may be I will hope the correction if any trouble or suggestion:

In Module:

Public Const OLECMDID_SELECTALL = 17 '(&H11)
Public Const OLECMDID_COPY = 12
Public Const OLECMDID_CUT = 11
Public Const OLECMDID_PASTE = 13
Public Const OLECMDEXECOPT_DODEFAULT = 0

Private Const WM_CUT = &H300
Private Const WM_COPY = &H301
Private Const WM_PASTE = &H302
Private Const WM_CLEAR = &H303
Private Const WM_SELECTALL = &HB1
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal _
    hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    lParam As Any) As Long

' Copy the contents of a control into the Clipboard
Sub ControlCopy(ByVal hwnd As Long)
    SendMessage hwnd, WM_COPY, 0, ByVal 0&
End Sub

' Cut the contents of a control into the Clipboard
Sub ControlCut(ByVal hwnd As Long)
    SendMessage hwnd, WM_CUT, 0, ByVal 0&
End Sub

' Paste the contents of the Clipboard into a control
Sub ControlPaste(ByVal hwnd As Long)
    SendMessage hwnd, WM_PASTE, 0, ByVal 0&
End Sub

' Delete the selected contents of a control
Sub ControlDelete(ByVal hwnd As Long)
    SendMessage hwnd, WM_CLEAR, 0, ByVal 0&
End Sub

Sub ControlSelectAll(ByVal hwnd As Long)
    SendMessage hwnd, WM_SELECTALL, ByVal 0&, ByVal -1
End Sub

In Form:

Option Explicit

Private WithEvents objWeb As VBControlExtender
Private web1 As Object

Private Sub btnCopy_Click()
    Clipboard.Clear
    ControlSelectAll RichTextBox1.hwnd
    Clipboard.SetText RichTextBox1.SelRTF, vbCFRTF
    objWeb.Visible = True
    web1.Document.body.contentEditable = True
    web1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
    web1.ExecWB OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT
    web1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
    web1.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
    web1.ExecWB OLECMDID_CUT, OLECMDEXECOPT_DODEFAULT
    objWeb.Visible = False
End Sub

Private Sub BtnGetUnicode_Click()
      Dim Jwb As String
      Dim VarResult As Variant
      Dim LpCntr As Integer
      Dim CSVResult As String
      
      CSVResult = ""
      VarResult = Split(RichTextBox1.TextRTF, "\")
      For LpCntr = 0 To UBound(VarResult)
           MsgBox VarResult(LpCntr)
           If UCase(Left(VarResult(LpCntr), 1)) = "F" Or UCase(Left(VarResult(LpCntr), 1)) = "U" Or UCase(Left(VarResult(LpCntr), 1)) = "'" Then
              If CSVResult = "" Then CSVResult = VarResult(LpCntr) Else CSVResult = CSVResult & "," & VarResult(LpCntr)
           End If
      Next
      CSVResult = Replace(CSVResult, "{", "")
      CSVResult = Replace(CSVResult, "}", "")
      CSVResult = Replace(CSVResult, ";", "")
      CSVResult = Replace(CSVResult, "?", "")
      Debug.Print CSVResult
      MsgBox CSVResult
End Sub

Private Sub Form_Load()
    Dim i As Long

    Set objWeb = Controls.Add("Shell.Explorer.2", "web1", Me)
    objWeb.Visible = False
    objWeb.Left = -1000
    Set web1 = objWeb.object
    With web1
        .Offline = True
        .Silent = True
        .RegisterAsBrowser = False
        .RegisterAsDropTarget = False
        .MenuBar = False
        .ToolBar = 0
        .Navigate "about:blank"
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
   If Not web1 Is Nothing Then
     Set web1 = Nothing
   End If
End Sub

Private Sub Paste_Click()
    objWeb.Visible = True
    web1.Document.body.contentEditable = True
    web1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
    web1.ExecWB OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT
    web1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
    web1.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
    ControlPaste RichTextBox1.hwnd
    web1.ExecWB OLECMDID_CUT, OLECMDEXECOPT_DODEFAULT
    objWeb.Visible = False
End Sub

In My Test Are as follow:

な質問ですが 最近とても不思議に思
RichTextBox1

CSV Result:

froman,fcharset0 Times New Roman,f1,fnil,fcharset0 MS Sans Serif
,f0,fs24,u12394,u36074,u21839,u12391,u12377,u12364 ,u26368,u36817,u12392,u12390,u12418,u19981,u24605,u35696,u12395,u24605
,f1,fs17 RichTextBox1

If the Result I Convert To TextRtf again:

       RichTextBox1.TextRTF = "{\deff0{\fonttbl{\f0}}\f0\fs24\u12394?\u36074?\u21839?\u12391?\u12377?\u12364?\u26368?\u36817?\u12392?\u12390?\u12418?\u19981?\u24605?\u35696?\u12395?\u24605?\fs17 RichTextBox1}"

and Get Unicode again, The Result are as follows(charset 128):

fonttbl,f0,froman,fprq1,fcharset128 MS UI Gothic,f1,fmodern,fprq6,fcharset134 SimSun,f2,fnil 
,uc1,f0,fs24,'82,'c8,f1,'d9,'7c,'86,'96,f0,'82,'c5,'82,'b7,'82,'aa,'8d,'c5,'8b,'df,'82,'c6,'82,'c4,'82,'e0,'95,'73,'8e,'76,'8b,'63,'82,'c9,'8e,'76,f2,fs17 RichTextBox1

fonttbl,f0,froman,fprq1,fcharset128 MS UI Gothic,
          f1,fmodern,fprq6,fcharset134 SimSun, 
          f2,fnil,uc1,
          f0,fs24,'82,'c8, ==>82c8 with charset128 MS UI Gothic
          f1,'d9,'7c,'86,'96,==>d97c and 8696 with charset134 SimSun
          f0,'82,'c5,'82,'b7,'82,'aa,'8d,'c5,'8b,'df, ==>82C5,82B7,82aa,8dc5,8bdf with charset128 MS UI Gothic
              '82,'c6,'82,'c4,'82,'e0,'95,'73,'8e,'76,==>82c6,82c4,82e0,9573,8e76 with charset128 MS UI Gothic
              '8b,'63,'82,'c9,'8e,'76,                   ==>8b63,82c9,8e76                with charset128 MS UI Gothic
          f2,fs17 RichTextBox1                        ==>RichTextBox1                    Ansi

Remarks: fs --> FontSize
f0~fn --> Font Definition
u --> Indicate unicode no need charset
' --> Indicate unicode with charset
RichTextBox1 --> Non unicode text