Página 1 de 1

Problema na execução de Código em computador Diferente

Enviado: Sáb Jul 11, 2020 7:54 pm
por W. Cavalcante
Boa noite pessoal,

estou com um problema que está me tirando o sono.

Tenho uma aplicação onde utilizo VBA para copiar informações de uma planilha e inserir em um Site.
Utilizo Windows 10, x64
meu Office é o 2016 x64

muito bem, aqui roda tudo direitinho, tenho outro computador com o mesmo sistema acima que também roda igual.
o problema é que têm usurário que está tendo problemas com a aplicação utilizando o mesmo windows e o mesmo office. como pode?

Utilizo as APIs e Funções abaixo para Enviar Área de Transferência e Pegar dados da Área de transferência.
Anexo envio a imagem dos error;

Também ocorre o mesmo erro em uma parte bem simples do código, que da pra ver na imagem.. é apenas uma formatação.. e da erro lá tbm..


Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal lpShowCmd As Long) As Long
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems

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

Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Public Sub SetClipboard(sUniText As String)
Dim iStrPtr As LongPtr
Dim iLen As LongPtr
Dim iLock As LongPtr
Const GMEM_MOVEABLE As LongPtr = &H2
Const GMEM_ZEROINIT As LongPtr = &H40
Const CF_UNICODETEXT As LongPtr = &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

Function ClipBoard_GetData()
Dim hClipMemory As LongPtr
Dim lpClipMemory As LongPtr
Dim MyString As String
Dim RetVal As LongPtr

If OpenClipboard(0&) = 0 Then
MsgBox "Cannot open Clipboard. Another app. may have it open"
Exit Function
End If

' Obtain the handle to the global memory
' block that is referencing the text.
hClipMemory = GetClipboardData(CF_TEXT)
If IsNull(hClipMemory) Then
MsgBox "Could not allocate memory"
GoTo OutOfHere
End If

' Lock Clipboard memory so we can reference
' the actual data string.
lpClipMemory = GlobalLock(hClipMemory)

If Not IsNull(lpClipMemory) Then
MyString = Space$(MAXSIZE)
RetVal = lstrcpy(MyString, lpClipMemory)
RetVal = GlobalUnlock(hClipMemory)

' Peel off the null terminating character.
MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
Else
MsgBox "Could not lock memory to copy string from."
End If

OutOfHere:

RetVal = CloseClipboard()
ClipBoard_GetData = MyString

End Function