Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal Format As Long, ByVal hMem As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal Flags As Long, ByVal length 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 GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal pDest As Long, ByVal pSource As Long, ByVal length As Long)
 
Private Const CF_TEXT = 1
Private Const CF_UNICODETEXT = 13
Private Const GHND = &H42&
 
' hWnd 一般可用Me.HWnd，也可为0
Public Function ClipboardSetText(ByVal hWnd As Long, ByVal sText$) As Boolean
    Dim hMem As Long, pMem As Long, s$
    Dim bOk As Boolean
    
    If OpenClipboard(hWnd) = 0 Then Exit Function
    EmptyClipboard
    
    ' ANSI
    s = StrConv(sText, vbFromUnicode)
    hMem = GlobalAlloc(GHND, LenB(s) + 1)
    pMem = GlobalLock(hMem)
    CopyMemory ByVal pMem, ByVal StrPtr(s), LenB(s)
    GlobalUnlock hMem
    bOk = SetClipboardData(CF_TEXT, hMem) <> 0
    If Not bOk Then GlobalFree hMem
    
    ' UNICODE:
    hMem = GlobalAlloc(GHND, LenB(sText) + 2)
    pMem = GlobalLock(hMem)
    CopyMemory ByVal pMem, ByVal StrPtr(sText), LenB(sText)
    GlobalUnlock hMem
    bOk = SetClipboardData(CF_UNICODETEXT, hMem) <> 0
    If Not bOk Then GlobalFree hMem
    
    CloseClipboard
    ClipboardSetText = bOk
End Function
 
Private Sub Command1_Click()
    MsgBox ClipboardSetText(Me.hWnd, Text1.Text)
End Sub