VBA Access: Código da error en Access x64
Tengo este código para usar el portapapeles:
Option Explicit #If VBA7 And Win64 Then Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long Private Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As Long Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Long Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long Private Declare PtrSafe Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long Private Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long #Else 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 GlobalSize Lib "kernel32" (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 #End If Public Sub SetClipboard(sUniText As String) 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 Sub Public Function GetClipboard() As String 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 GetClipboard = sUniText End If CloseClipboard End Function
Recibo un error de no coinciden los tipos en la línea:
Lstrcpy iLock, StrPtr(sUniText)
Sobre StrPtr.
Desconozco qué lo causa o cómo resolverlo. Excede a mi conocimiento.
1 respuesta
Sasha: Prueba sustituyendo >>
Public Sub SetClipboard(sUniText As String) Por ésta otra >> Public Sub SetClipboard(sUniText As Variant)
Un saludo >> Jacinto
Shasa: Creo que hay otras líneas del otro procedimiento que van a quedar afectadas.
Public Function GetClipboard() As String Dim iStrPtr As Long Dim iLen As Long Dim iLock As Long 'Dim sUniText As String Dim sUniText As Variant 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) sUniText = (iLen \ 2& - 1&, vbNullChar) lstrcpy StrPtr(sUniText), iLock GlobalUnlock iStrPtr End If GetClipboard = sUniText End If CloseClipboard End Function
Ya me contarás >> saludos >> Jacinto
Sasha: No sé si has recibido la amplición de mi respuesta en la que te comentaba que había otras líneas del Procedimiento de abajo que también quedarían afectadas >>
Public Function GetClipboard() As String Dim iStrPtr As Long Dim iLen As Long Dim iLock As Long 'Dim sUniText As String >> Cambiarla a: Dim sUniText As Variant 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) >> Cambiarla a: sUniText = (iLen \ 2& - 1&, vbNullChar) lstrcpy StrPtr(sUniText), iLock GlobalUnlock iStrPtr End If GetClipboard = sUniText End If CloseClipboard End Function
Un saludo >> jacinto
Con el cambio me funcionó en un momento pero después volvió a dar la misma falla.
No sé qué hacer.
Sasha: Hay alguna razón especial por la que debas usar el StrPtr.
Si es así profundizo un poco. Me comentas por favor. Un saludo >> Jacinto
Sasha: Ignoro si habrá alguna cuestión más, pero las dos funciones que te cito has de cambiarlas.
Tal como te cito a continuación. Un saludo >> Jacinto
Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Muchas gracias, Jacinto. Al código lo obtuve directamente de la web de Microsoft para el uso del Portapapeles para copiar. Todo eso que ves en el código original está usado tal cual aparece en la web. Me funciona en Access 32 bits pero no en 64.
Sobre tus cambios sugeridos no han cambiado el resultado.
Te paso el nuevo código para que lo veas y seguro encontrarás algo que yo no logro ver:
Option Compare Database Option Explicit #If VBA7 And Win64 Then Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long Private Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As Long Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Long Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long ' Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As LongPtr ' Private Declare PtrSafe Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long Private Declare PtrSafe Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr Private Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long #Else 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 GlobalSize Lib "kernel32" (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 #End If 'Public Sub SetClipboard(sUniText As String) >> Cambiar a Public Sub SetClipboard(sUniText As Variant) 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 Sub Public Function GetClipboard() As String Dim iStrPtr As Long Dim iLen As Long Dim iLock As Long ' Dim sUniText As String >> Cambiarla a: Dim sUniText As Variant 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 GetClipboard = sUniText End If CloseClipboard End Function
Siempre el foco se da en la misma línea:
lstrcpy iLock, StrPtr(sUniText)
Y el problema en StrPtr.
Sasha: Cuando citas que el código lo sacaste de Microsoft imagino que será el de 32 bits, ya que si ellos han escrito el de 64 debe ser un lapsus.
El tema no es sencillo, porque aparte de las Funciones en las que hay que transformar variables de tipo Long a LongPtr supongo que habrá que cambiar algunas Constantes también.
En las funciones, aunque delicado, se pueden intuir, porque según he podido leer,
"Cualquier cosa llamada un identificador, puntero, pincel o cualquier otro tipo de objeto requerirá un LongPtr en 64 bits."
"Cualquier cosa que sea estrictamente datos puede permanecer como Long."
A partir de aquí te cito las Funciones que a mi modo de ver resuelven eltema de 64 bits
Quedará la parte de las Constantes y variables en los procedimientos, que en principio no veo como hacerlo, aunque algo de camino intentaré abrirte.
#If VBA7 And Win64 Then ‘Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long Private Declare PtrSafe Function OpenClipboard Lib "user32" Alias "OpenClipboard" (ByVal hwnd As LongPtr) As Long Private Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As Long Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Long Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long 'Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long Private Declare PtrSafe Function GetClipboardData Lib "user32" Alias "GetClipboardDataA" (ByVal wFormat As Long) As LongPtr 'Private Declare PtrSafe Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long Private Declare PtrSafe Function SetClipboardData Lib "user32" Alias "SetClipboardDataA" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr ‘Private Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" Alias "GlobalAlloc" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr ‘Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long Private Declare PtrSafe Function GlobalLock Lib "kernel32" Alias "GlobalLock" (ByVal hMem As LongPtr) As LongPtr ‘Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" Alias "GlobalUnlock" (ByVal hMem As LongPtr) As Long ‘Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long Private Declare PtrSafe Function GlobalSize Lib "kernel32" Alias "GlobalSize" (ByVal hMem As LongPtr) As LongPtr ‘Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long Private Declare PtrSafe Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As String) As LongPtr
En ésta página tienes una guia, para las Funciones y procedimientos de compilación condicional para el portapapeles.
Mira si es de utilidad para lo que tu pretendes y por mi parte intentaré dedicar algo de tiempo a la parte final. Si tu ves que al cambiar la metodología te resuelve el problema, me comentas.
Mis saludos >> jacinto
La verdad es que no ha funcionado. Lo que me pasas al último me genera otro error en otro punto así que he desistido. He adoptado una posibilidad un poco pobre de profesionalismo pero al menos me ha funcionado:
#If VBA7 And Win64 Then Me.txtCM.Enabled = True Me.txtCM.SetFocus DoCmd.RunCommand acCmdCopy Me.txtCM.Enabled = False #Else Call SetClipboard(Me.txtCM.Value) #End If
Si encuentras en este código algo que corregir, te pido sugerirlo. Por el momento uso esto.
Sasha: En primer lugar comentarte que te cité un enlace a una página que ahora veo que no puse.
https://www.francescofoti.com/2013/12/share-the-clipboard-with-vba-and-the-windows-api/
Que justo trata del tema que nos ocupa.
Con respecto a la modificación del que hemos ido inercambiando información, tengo un problema adicional, y es que no puedo hacer las pruebas en un Access de 64 bits, por lo tanto voy dando palos de ciego. Si encuentro la manera de hacerlas, te comentaría por eMail, ya que como lo veo, seguir alargando este post sin llegar a una solución clara no tiene mucho sentido.
Mis saludos >> Jacinto
