Accessで、32bitを64bitに変換したいです。

Question

前提

Accessで、32bitを64bitに変換したいのですが、
「型が一致しません」というエラーが起きてしまいます。

どうやら、GlobalSize()関数でエラーが起きているようです。
でも引数の型はLongPtrになっているので、なぜなのか分からず詰まっています。

ClipboardGetTextData = String$(GlobalSize(hGlobalMemory), vbNullChar) ' バッファ領域を確保する

ご教授いただければ幸いです。

Option Compare Database
Option Explicit

#If VBA7 Then ' 64-bit

  Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
  Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
  Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
  Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
  Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
  
  Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
  Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
  Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
  Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
  Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
  Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr

#End If

'//
'// GlobalAlloc wFlags パラメータ
'//
Private Const GMEM_MOVEABLE As Long = &H2       ' 移動可能メモリを割り当てます。メモリの断片化を防ぎます
Private Const GMEM_ZEROINIT As Long = &H40      ' メモリの内容を 0 へ初期化します。
Private Const GHND As Long = (GMEM_MOVEABLE Or GMEM_ZEROINIT)   ' 上記の各フラグの組み合わせです

'//
'// Get/SetClipboardData wFormat パラメータ
'//
Private Const CF_TEXT As Long = &H1


Public Function ClipboardGetTextData() As String

  Dim hClipMemory As LongPtr, hGlobalMemory As LongPtr
          
  If OpenClipboard(0) <> 0 Then
  
    hClipMemory = GetClipboardData(CF_TEXT) ' クリップボードオブジェクトのハンドルを取得します。
    
    hGlobalMemory = GlobalLock(hClipMemory) ' クリップボードヘの先頭アドレスを取得します。
    
    ClipboardGetTextData = String$(GlobalSize(hGlobalMemory), vbNullChar) ' バッファ領域を確保する
          
    Call lstrcpy(ClipboardGetTextData, hClipMemory) ' 確保したバッファヘ文字列をコピーします。
        
    Call GlobalUnlock(hClipMemory)  ' グローバルメモリオブジェクトのロックを解除します。
    
    Call CloseClipboard             ' クリップボードの権限を破棄します。
              
  End If
      
End Function


Public Function ClipboardSetTextData(ByVal sTextData As String) As Boolean

  Dim hGlobalMemory As LongPtr, hClipMemory As LongPtr
      
' VBA では内部処理において文字列を Unicode で扱っているため、単純にバイト数を
' 取得すると半角・全角にかかわらず1文字2バイトが返ってきます。
' そのため文字コードを Shift_JIS に変換後にバイト数を取得してます。
  hGlobalMemory = GlobalAlloc(GHND, LenB(StrConv(sTextData, vbFromUnicode)) + 1)
  
  hClipMemory = GlobalLock(hGlobalMemory) ' 確保したバッファヘの先頭アドレスを取得します。
  
  Call lstrcpy(hClipMemory, sTextData)    ' 確保したバッファヘ文字列をコピーします。
  
  Call GlobalUnlock(hGlobalMemory)        ' グローバルメモリオブジェクトのロックを解除します。
    
  If OpenClipboard(0) <> 0 Then           ' クリップボードの内容の変更権限を取得します。

    Call EmptyClipboard ' 現在のクリップボードを空にします。
    
  ' クリップボードにデータを格納する。その際引数で渡されたグローバルメモリブロックは
  ' システムが管理するため、ハンドルの解放やロックし続けることをしてはなりません。
    Call SetClipboardData(CF_TEXT, hGlobalMemory)
    
    Call CloseClipboard ' クリップボードの権限を破棄します。
    
    ClipboardSetTextData = True
    
  Else  ' クリップボードが他のプログラムなどで使用されている。
  
  ' 使用されなかったハンドルを解放する
    Call GlobalFree(hGlobalMemory)
    
    ClipboardSetTextData = False
  
  End If
          
End Function
    

Answer 1

String 関数 (Visual Basic for Applications) | Microsoft Learn

ClipboardGetTextData = String$(GlobalSize(hGlobalMemory), vbNullChar) ' バッファ領域を確保する

String関数の引数がLong型なので、それにLongPtr型を入れようとしているので、型が合わないとなるのでしょう。

ClipboardGetTextData = String$(CLng(GlobalSize(hGlobalMemory)), vbNullChar) ' バッファ領域を確保する

とすればエラーなく結果が返るようです。
ただ、クリップボードのサイズがLong型より多い場合はどうなるかは試してません。
たぶん、Long型のサイズに切り取られると思いますが。

おまけ

ちなみに、クリップボードからテキストを取得したり、送ったりするなら、 APIを使わず MSForms.DataObject を使う方法があります。こちらの方が簡単だと思います。

クリップボードとデータのやりとりをする：Excel VBA｜即効テクニック｜Excel VBAを学ぶならmoug

上記はExcelのVBAですが、Access VBAでも使えます。
上記を参考に、「Microsoft Forms 2.0 Object Library」に参照設定をします。

あとは、標準モジュールに下記のコードを記述します。

Public Function GetClipboardText() As String
    On Error GoTo ErrExit 'クリップボードにテキストデータがない場合のエラー対策
    With New MSForms.DataObject
        .GetFromClipboard    '変数のデータをDataObjectに格納する
        GetClipboardText = .GetText
    End With
ErrExit:
End Function

Public Function SetClipboardText(ByVal sTextData As String) As Boolean
    On Error GoTo ErrExit 'クリップボードにテキストデータがない場合のエラー対策
    With New MSForms.DataObject
        .SetText sTextData '変数の値をDataObjectに格納する
        .PutInClipboard    'DataObjectのデータをクリップボードに格納する
        SetClipboardText = True
    End With
ErrExit:
End Function

Public Sub Test()
    Dim s As String
    s = "Test"

    If SetClipboardText(s) Then MsgBox "クリップボードにテキストを格納しました。"
    
    MsgBox "クリップボードのテキストは'" & GetClipboardText() & "'"

End Sub

Comments

[thth456]

ご回答ありがとうございます。
自分でも調べたところ、確かにString関数の引数はLong型になっていました！
おかげさまで無事、解決しました。

[thth456]

おまけもありがとうございます。
試してみます！