GDIplusCODE


'クリップボードからHtmlのフラグメントを読込、Accessのメモ型フィールドに書き込む
'YU-TANGさんがWebサイトで公開されていたクラスのほんの一部の機能を使わせていただいております。
'Webサイトは既に閉じられてしまいましたが、アーカイブを公開されていますので、ダウンロードして自PC上に再現可能です。
Private Sub importCbButton_Click()
  Dim htm As HtmlClipboardFormat
    
  If Clipboard.ContainsAny("HTML Format") Then
      htm = Clipboard.HTML
      With htm
          Me.表html = .Fragment
      End With
  Else
    MsgBox "Htmlデータがクリップボードに存在しません"
  End If
End Sub

'ブラウザを起動してhtmlデータを表示
Private Sub displayHtmlButton_Click()
  'テンポラリのテキストファイルに保存して規定のブラウザを起動する
    Dim FSO As Object
    Dim dstFilePath As String
    Dim WSH As Object 
      
    Set FSO = CreateObject("Scripting.FileSystemObject")
    'Temporaryフォルダに一時保存
    dstFilePath = FSO.GetSpecialFolder(2) & "\" & "myTemporary.html"
    With FSO.CreateTextFile(dstFilePath)
        .WriteLine Me.表html
        .Close
    End With
    Set FSO = Nothing

    Set WSH = CreateObject("WScript.Shell")
    WSH.Run dstFilePath
    Set WSH = Nothing
End Sub

戻る


'***********************************
' クリップボードからhtmlソースを取り出す。shift_JIS以外にも対応。
'
'ADOに参照設定要

'----------------------------------------------------------------------------
'クリップボード関連
'----------------------------------------------------------------------------
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function EnumClipboardFormats Lib "user32.dll" (ByVal format As Long) As Long
Private Declare Function GetClipboardFormatName Lib "user32.dll" Alias "GetClipboardFormatNameA" (ByVal format As Long, ByVal lpszFormatName As String, ByVal cchMaxCount As Long) As Long
Private Declare Function CountClipboardFormats Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal format As Long) As Long

Private Const CF_BITMAP = 2
Private Const CF_DIB = 8
Private Const CF_DIF = 5
Private Const CF_DSPBITMAP = &H82
Private Const CF_DSPENHMETAFILE = &H8E
Private Const CF_DSPMETAFILEPICT = &H83
Private Const CF_DSPTEXT = &H81
Private Const CF_ENHMETAFILE = 14
Private Const CF_GDIOBJFIRST = &H300
Private Const CF_GDIOBJLAST = &H3FF
Private Const CF_METAFILEPICT = 3
Private Const CF_OEMTEXT = 7
Private Const CF_OWNERDISPLAY = &H80
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_PRIVATEFIRST = &H200
Private Const CF_PRIVATELAST = &H2FF
Private Const CF_RIFF = 11
Private Const CF_SYLK = 4
Private Const CF_TEXT = 1
Private Const CF_TIFF = 6
Private Const CF_UNICODETEXT = 13
Private Const CF_WAVE = 12
'追加
Private Const HTML_Format = 49364 '49382

'----------------------------------------------------------------------------
'メモリ関連
'----------------------------------------------------------------------------
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem 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 GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
'Private Const GMEM_MOVEABLE = &H2

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
     
'文字エンコード確認用
Public Enum EncodingJP
    NONE = 0
    ASCII = 1
    sjis = 2
    EUC = 3
    JIS = 4
    UTF16_LE = 5
    UTF16_BE = 6
    utf8 = 7
    UTF8_BOM = 8
    UTF7 = 9
End Enum
     

'------------------------------------------------
' 動作試験用
'------------------------------------------------

Sub test_getHtmlInCB()
  Dim buf As String
  
  buf = getHtmlInCB
  '<html>をみつけて、それ以降を切り出せばhtmlとして通用する筈
  Debug.Print Right(buf, Len(buf) - InStr(buf, "<html>") + 1)
End Sub

'**********************************
'
'  クリップボードからHTML Formatのデータを取得
'
'**********************************

Function getHtmlInCB() As String
    Dim data()  As Byte
    Dim hMem As Long
    Dim dwBytes As Long
    Dim p As Long
    Dim i As Long, j As Long
    Dim strResult As String
    Dim buf As Variant
    'CF_HTML（相当）は何らかのタイミングで変化するらしい。ChromeもIEも共通なのでOSサイドの都合？
    Dim CF_HTML As Long
    Dim ret As Long
    Dim myCharset As String
    
    'CF_HTMLを取得
    ret = getCF_Html
    If ret = 0 Then
      getHtmlInCB = ""
      Exit Function
    Else
      CF_HTML = ret
    End If
    'クリップボードを開く
    If OpenClipboard(0&) Then
        hMem = GetClipboardData(CF_HTML)
        If hMem Then
            'バイト数取得
            dwBytes = GlobalSize(hMem)
            'グローバルメモリオブジェクトをロック(ポインタ取得)
            p = GlobalLock(hMem)
            '再割り当て
            ReDim data(0 To dwBytes - 1)
            'byte配列data()に取得したデータをコピー
            MoveMemory VarPtr(data(0)), p, dwBytes
            'メモリオブジェクトのロックを解除
            GlobalUnlock hMem
            CloseClipboard
            
            'byte配列の文字コード取得
            myCharset = charsetName(data())
            'ADO.streamでUnicodeに変換
            getHtmlInCB = GetString(data(), myCharset)
            
        End If
    End If
End Function

'*** ADO.streamによりbyte配列から、指定エンコードで文字列に変換 ***
'http://www.papy.in/bbs/vb1/200608/06080083.html
Public Function GetString(ByRef bin() As Byte, ByVal encoding As String) As String
    With New ADODB.Stream
        .Open
        .Type = adTypeBinary
        .Write bin
        .Position = 0
        .Type = adTypeText
        .charSet = encoding
        GetString = .ReadText(adReadAll)
        .Close
    End With
End Function

'*** CF_HTML相当のリテラル値を取得
'下記URLのコードを若干変更
'http://www.hanatyan.sakura.ne.jp/vb60bbs/wforum.cgi?no=14459&reno=no&oya=14459&mode=msgview&page=0
Function getCF_Html() As Long
    Dim ret As Long
    Dim buf As String ', buf2 As String, wk As String
    Dim fc As Long, lc As Long
    
    lc = 0
    ret = OpenClipboard(Application.hwnd)
    If ret <> 0 Then
        fc = 0
        Do
            fc = EnumClipboardFormats(fc)
            If fc <> 0 Then
                Select Case fc
                    Case 1: buf = "CF_TEXT"
                    Case 2: buf = "CF_BITMAP"
                    Case 3: buf = "CF_METAFILEPICT"
                    Case 4: buf = "CF_SYLK"
                    Case 5: buf = "CF_DIF"
                    Case 6: buf = "CF_TIFF"
                    Case 7: buf = "CF_OEMTEXT"
                    Case 8: buf = "CF_DIB"
                    Case 9: buf = "CF_PALETTE"
                    Case 10: buf = "CF_PENDATA"
                    Case 11: buf = "CF_RIFF"
                    Case 12: buf = "CF_WAVE"
                    Case 13: buf = "CF_UNICODETEXT"
                    Case 14: buf = "CF_ENHMETAFILE"
                    Case &H80: buf = "CF_OWNERDISPLAY"
                    Case &H81: buf = "CF_DSPTEXT"
                    Case &H82: buf = "CF_DSPBITMAP"
                    Case &H83: buf = "CF_DSPMETAFILEPICT"
                    Case &H8E: buf = "CF_DSPENHMETAFILE"
                    Case &H200: buf = "CF_PRIVATEFIRST"
                    Case &H2FF: buf = "CF_PRIVATELAST"
                    Case &H300: buf = "CF_GDIOBJFIRST"
                    Case &H3FF: buf = "CF_GDIOBJLAST"
                    Case Else
                    buf = String(255, vbNullChar)
                    ret = GetClipboardFormatName(fc, buf, 254&)
                    buf = Left(buf, ret)
                    If buf = "HTML Format" Then
                      getCF_Html = fc
                      GoTo terminate
                    End If
                End Select
                lc = lc + 1
            End If
            DoEvents
        Loop Until fc = 0
    End If
  'CF_Htmlが取得出来ないとき0を戻す
  getCF_Html = 0
terminate:
  ret = CloseClipboard()
End Function


'*** byte配列のエンコード判定メイン ***
'ADOに直に渡せる様に改造させていただいております
'http://krt21.xsrv.jp/blog/?p=23
'utf-8しか検証しておりません。

Function charsetName(ByRef bytes() As Byte) As String
    Dim result As String
    Dim enc As EncodingJP
    enc = encodingCheck(bytes)
    Select Case enc
        Case EncodingJP.NONE
            result = "NONE"
        Case EncodingJP.ASCII
            result = "ascii"
        Case EncodingJP.sjis
            result = "shift_jis"
        Case EncodingJP.EUC
            result = "euc-jp"
        Case EncodingJP.JIS
            result = "iso-2022-jp"
        Case EncodingJP.UTF16_LE
            result = "utf-16"
        Case EncodingJP.UTF16_BE
            'Windows レジストリの HKEY_CLASSES_ROOT\MIME\Database\Charsetに無いが使えるとの情報あり
            result = "utf-16be"
        Case EncodingJP.utf8
            result = "utf-8"
        'ADO.streamでutf-8で書き出すとBOM付きになる。
        Case EncodingJP.UTF8_BOM
            result = "utf-8"
        Case EncodingJP.UTF7
            result = "utf-7"
    End Select
    
    charsetName = result
End Function

'Function charsetNameで使用
Function encodingCheck(ByRef bytes() As Byte) As EncodingJP
    Dim i As Long, j As Long, k As Long
    Dim bytesSize As Long
    Dim result As EncodingJP
    result = EncodingJP.ASCII
    Dim AUTF7 As Long
    Dim AUTF8 As Long
    Dim ASJIS As Long
    Dim AEUC As Long
    Dim AANY As Long
    Dim CUTF7 As Long
    Dim CUTF8 As Long
    Dim CSJIS As Long
    Dim CEUC As Long
    AANY = 3
    
    bytesSize = UBound(bytes)
    If bytesSize > 1 Then
        If ((bytes(0) > 253) And (bytes(1) > 253)) Then
            result = EncodingJP.UTF16_LE
            If ((bytes(0) = 254) And (bytes(1) = 255)) Then
                result = EncodingJP.UTF16_BE
            End If
            encodingCheck = result
            Exit Function
        End If
        If ((bytes(0) = &HEF) And (bytes(1) = &HBB) And (bytes(2) = &HBF)) Then
            encodingCheck = EncodingJP.UTF8_BOM
            Exit Function
        End If
    End If
    
    For i = 0 To bytesSize
        If result = EncodingJP.ASCII Then
            If bytes(i) > &H7F Then
                result = EncodingJP.NONE
            ElseIf bytes(i) = &H1B Then
                If i + 2 < bytesSize Then
                    If (((bytes(i + 1) = Asc("$")) And ((bytes(i + 2) = Asc("@")) Or (bytes(i + 2) = Asc("B")) Or (bytes(i + 2) = Asc("(")))) Or _
                        ((bytes(i + 1) = Asc("(")) And ((bytes(i + 2) = Asc("B")) Or (bytes(i + 2) = Asc("J")) Or (bytes(i + 2) = Asc("I"))))) Then
                       encodingCheck = EncodingJP.JIS
                       Exit Function
                    End If
                End If
            ElseIf ((AUTF7 > -1) And (AUTF7 <= i)) Then
                If (bytes(AUTF7) = Asc("+")) Then
                    AUTF7 = AUTF7 + 1
                    Dim sum As Long
                    Do While AUTF7 < bytesSize
                        If (((bytes(AUTF7) >= Asc("0")) And (bytes(AUTF7) <= Asc("9"))) Or ((bytes(AUTF7) >= Asc("A")) And (bytes(AUTF7) <= Asc("Z"))) Or _
                            ((bytes(AUTF7) >= Asc("a")) And (bytes(AUTF7) <= Asc("z"))) Or (bytes(AUTF7) = Asc("+")) Or (bytes(AUTF7) = Asc("/"))) Then
                            sum = sum + 1
                        ElseIf bytes(AUTF7) = Asc("-") Then
                            If (sum * 6) Mod 16 > 5 Then
                                AUTF7 = -1
                                Exit Do
                            End If
                            If (CUTF7 > 0) Then
                                encodingCheck = EncodingJP.UTF7
                                Exit Function
                            End If
                            AUTF7 = AUTF7 + 1
                            CUTF7 = CUTF7 + AUTF7 - i
                            Exit Do
                        Else
                            AUTF7 = -1
                            Exit Do
                        End If
                        AUTF7 = AUTF7 + 1
                    Loop
                Else
                    AUTF7 = AUTF7 + 1
                End If
            End If
        End If
        If ((AUTF8 > -1) And (AUTF8 <= i)) Then
            If (bytes(AUTF8) <= &H7F) Then
                AUTF8 = AUTF8 + 1
            ElseIf ((bytes(AUTF8) >= &HC2) And (bytes(AUTF8) <= &HDF)) Then
                If ((AUTF8 + 1 < bytesSize) And _
                    (bytes(AUTF8 + 1) >= &H80) And (bytes(AUTF8 + 1) <= &HBF)) Then
                    
                    AUTF8 = AUTF8 + 2
                    CUTF8 = CUTF8 + 2
                Else
                    AUTF8 = -1
                    AANY = AANY - 1
                End If
            ElseIf (bytes(AUTF8) = &HE0) Then
                If ((AUTF8 + 2 < bytesSize) And _
                    (bytes(AUTF8 + 1) >= &HA0) And (bytes(AUTF8 + 1) <= &HBF) And _
                    (bytes(AUTF8 + 2) >= &H80) And (bytes(AUTF8 + 2) <= &HBF)) Then
                    
                    AUTF8 = AUTF8 + 3
                    CUTF8 = CUTF8 + 3
                Else
                    AUTF8 = -1
                    AANY = AANY - 1
                End If
            ElseIf ((bytes(AUTF8) >= &HE1) And (bytes(AUTF8) <= &HEF)) Then
                If ((AUTF8 + 2 < bytesSize) And _
                    (bytes(AUTF8 + 1) >= &H80) And (bytes(AUTF8 + 1) <= &HBF) And _
                    (bytes(AUTF8 + 2) >= &H80) And (bytes(AUTF8 + 2) <= &HBF)) Then
                
                    AUTF8 = AUTF8 + 3
                    CUTF8 = CUTF8 + 3
                Else
                    AUTF8 = -1
                    AANY = AANY - 1
                End If
            ElseIf (bytes(AUTF8) = &HF0) Then
                If ((AUTF8 + 3 < bytesSize) And _
                    (bytes(AUTF8 + 1) >= &H90) And (bytes(AUTF8 + 1) <= &HBF) And _
                    (bytes(AUTF8 + 2) >= &H80) And (bytes(AUTF8 + 2) <= &HBF) And _
                    (bytes(AUTF8 + 3) >= &H80) And (bytes(AUTF8 + 3) <= &HBF)) Then
                        
                    AUTF8 = AUTF8 + 4
                    CUTF8 = CUTF8 + 4
                Else
                    AUTF8 = -1
                    AANY = AANY - 1
                End If
            ElseIf ((bytes(AUTF8) >= &HF1) And (bytes(AUTF8) <= &HF3)) Then
                If ((AUTF8 + 3 < bytesSize) And _
                    (bytes(AUTF8 + 1) >= &H80) And (bytes(AUTF8 + 1) <= &HBF) And _
                    (bytes(AUTF8 + 2) >= &H80) And (bytes(AUTF8 + 2) <= &HBF) And _
                    (bytes(AUTF8 + 3) >= &H80) And (bytes(AUTF8 + 3) <= &HBF)) Then
                
                    AUTF8 = AUTF8 = 4
                    CUTF8 = CUTF8 + 4
                Else
                    AUTF8 = -1
                    AANY = AANY - 1
                End If
            ElseIf (bytes(AUTF8) = &HF4) Then
                If ((AUTF8 + 3 < bytesSize) And _
                    (bytes(AUTF8 + 1) >= &H80) And (bytes(AUTF8 + 1) <= &H8F) And _
                    (bytes(AUTF8 + 2) >= &H80) And (bytes(AUTF8 + 2) <= &HBF) And _
                    (bytes(AUTF8 + 3) >= &H80) And (bytes(AUTF8 + 3) <= &HBF)) Then
                    
                    AUTF8 = AUTF8 + 4
                    CUTF8 = CUTF8 + 4
                Else
                    AUTF8 = -1
                    AANY = AANY - 1
                End If
            Else
                AUTF8 = -1
                AANY = AANY - 1
            End If
        End If
        If ((ASJIS > -1) And (ASJIS <= i)) Then
            If (bytes(ASJIS) <= &H7F) Then
                ASJIS = ASJIS + 1
            ElseIf ((bytes(ASJIS) >= &HA0) And (bytes(ASJIS) <= &HDF)) Then
                ASJIS = ASJIS + 1
            ElseIf (bytes(ASJIS) = &H80) Then
                ASJIS = ASJIS + 1
            ElseIf (((bytes(ASJIS) >= &H81) And (bytes(ASJIS) <= &H9F)) Or ((bytes(ASJIS) >= &HE0) And (bytes(ASJIS) <= &HFC))) Then
                
                If ((ASJIS + 1 < bytesSize) And _
                    (((bytes(ASJIS + 1) >= &H40) And (bytes(ASJIS + 1) <= &H7E)) Or _
                     ((bytes(ASJIS + 1) >= &H80) And (bytes(ASJIS + 1) <= &HFC)))) Then
                    
                    ASJIS = ASJIS + 2
                    CSJIS = CSJIS + 2
                Else
                    ASJIS = -1
                    AANY = AANY - 1
                End If
            End If
        End If
        If ((AEUC > -1) And (AEUC <= i)) Then
            If (bytes(AEUC) <= &H7F) Then
                AEUC = AEUC + 1
            ElseIf (bytes(AEUC) = &H8E) Then
                If ((AEUC + 1 < bytesSize) And _
                    (bytes(AEUC + 1) >= &HA1) And (bytes(AEUC + 1) <= &HDF)) Then
                    
                    AEUC = AEUC + 2
                    CEUC = CEUC + 2
                Else
                    AEUC = -1
                    AANY = AANY - 1
                End If
            ElseIf (bytes(AEUC) = &H8F) Then
                If ((AEUC + 2 < bytesSize) And _
                    (bytes(AEUC + 1) >= &HA1) And (bytes(AEUC + 1) <= &HFE) And _
                    (bytes(AEUC + 2) >= &HA1) And (bytes(AEUC + 2) <= &HFE)) Then
                
                    AEUC = AEUC + 3
                    CEUC = CEUC + 3
                Else
                    AEUC = -1
                    AANY = AANY - 1
                End If
            ElseIf ((bytes(AEUC) >= &HA1) And (bytes(AEUC) <= &HFF)) Then
                If ((AEUC + 1 < bytesSize) And _
                    (bytes(AEUC + 1) >= &HA1) And (bytes(AEUC + 1) <= &HFE)) Then
                
                    AEUC = AEUC + 2
                    CEUC = CEUC + 2
                Else
                    AEUC = -1
                    AANY = AANY - 1
                End If
            Else
                AEUC = -1
                AANY = AANY - 1
            End If
        End If
        If (result <> EncodingJP.ASCII) Then
            If (AANY <= 1) Then
                If (AUTF8 > -1) Then
                    encodingCheck = EncodingJP.utf8
                    Exit Function
                End If
                If (ASJIS > -1) Then
                    encodingCheck = EncodingJP.sjis
                    Exit Function
                End If
                If (AEUC > -1) Then
                    encodingCheck = EncodingJP.EUC
                    Exit Function
                End If
                If (CUTF7 > 0) Then
                    result = EncodingJP.UTF7
                End If
                If (CUTF8 > CUTF7) Then
                    result = EncodingJP.utf8
                End If
                If ((CSJIS > CUTF8) And (CSJIS > CUTF7)) Then
                    result = EncodingJP.sjis
                End If
                If ((CEUC > CSJIS) And (CEUC > CUTF8) And (CEUC > CUTF7)) Then
                    result = EncodingJP.EUC
                End If
                encodingCheck = result
                Exit Function
            End If
        End If
    Next i
    
    If ((result = EncodingJP.ASCII) And (AUTF7 > -1) And (CUTF7 > 0)) Then
        encodingCheck = EncodingJP.UTF7
        Exit Function
    End If
    If ((AUTF8 > -1) And (CUTF8 > 0)) Then
        encodingCheck = EncodingJP.utf8
        Exit Function
    End If
    If ((ASJIS > -1) And (CSJIS > CUTF8)) Then
        encodingCheck = EncodingJP.sjis
        Exit Function
    End If
    If ((AEUC > -1) And (CEUC > CSJIS) And (CEUC > CUTF8)) Then
        encodingCheck = EncodingJP.EUC
        Exit Function
    End If
    encodingCheck = result
End Function

'検証用
'clipbrd.exeの結果と見比べてみる。CF_HTML相当の値が日によって？相違している事が分かる
'http://www.hanatyan.sakura.ne.jp/vb60bbs/wforum.cgi?no=14459&reno=no&oya=14459&mode=msgview&page=0

Sub ListClipboard()
'クリップボードのデータ形式をリストアップ
    Dim ret As Long
    Dim buf As String, buf2 As String, wk As String
    Dim fc As Long, lc As Long
    Dim disp As String
    lc = 0
    ret = OpenClipboard(Application.hwnd)
    'ret = OpenClipboard(ByVal 0&)
    If ret <> 0 Then
        disp = CountClipboardFormats() & Chr(10)
        fc = 0
        Do
            fc = EnumClipboardFormats(fc)
            If fc <> 0 Then
                buf2 = ""
                Select Case fc
                    Case 1: buf = "CF_TEXT"
                    Case 2: buf = "CF_BITMAP"
                    Case 3: buf = "CF_METAFILEPICT"
                    Case 4: buf = "CF_SYLK"
                    Case 5: buf = "CF_DIF"
                    Case 6: buf = "CF_TIFF"
                    Case 7: buf = "CF_OEMTEXT"
                    Case 8: buf = "CF_DIB"
                    Case 9: buf = "CF_PALETTE"
                    Case 10: buf = "CF_PENDATA"
                    Case 11: buf = "CF_RIFF"
                    Case 12: buf = "CF_WAVE"
                    Case 13: buf = "CF_UNICODETEXT"
                    Case 14: buf = "CF_ENHMETAFILE"
                    Case &H80: buf = "CF_OWNERDISPLAY"
                    Case &H81: buf = "CF_DSPTEXT"
                    Case &H82: buf = "CF_DSPBITMAP"
                    Case &H83: buf = "CF_DSPMETAFILEPICT"
                    Case &H8E: buf = "CF_DSPENHMETAFILE"
                    Case &H200: buf = "CF_PRIVATEFIRST"
                    Case &H2FF: buf = "CF_PRIVATELAST"
                    Case &H300: buf = "CF_GDIOBJFIRST"
                    Case &H3FF: buf = "CF_GDIOBJLAST"
                    Case Else
                    buf = String(255, vbNullChar)
                    ret = GetClipboardFormatName(fc, buf, 254&)
                    buf = Left(buf, ret)
                End Select
                lc = lc + 1
                disp = disp & lc & ":" & fc & ":" & buf & Chr(10)
            End If
            DoEvents
        Loop Until fc = 0
        ret = CloseClipboard()
    End If
    MsgBox (disp)
End Sub

WebページのtableをAccessのメモ型フィールドに保存し、Browserで表示