Access Database converted from Runtime 2007 issue.

[BButler]

Hi,

I'm a total novice sorry and not even sure if this is the correct sub-category to post this to.
I hope to get some assistance to restore my old Access database to function correctly.

The database is used to create and catalogue unique file IDs for use in my CAD Drafting work.
It has been converted from Access Runtime 2007 to Access 365. It runs 99% properly, except for one original feature.
Previously it would copy to the clipboard the new unique file ID which I could then save a new file by pasting from the clipboard. Avoiding typos etc.
This function no longer works. Could the below code that is held in 'Modules' be reviewed and amended to work in Access 365?

Any assistance would be greatly appreciated!

The code currently is as follows;




Option Compare Database
Option Explicit

'********* Code Start ************
' This code was originally written by Terry Kreft.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Terry Kreft
'
Public Const GHND = &H42
Public Const CF_TEXT = 1
Private Const CF_ANSIONLY = &H400&
Private Const CF_APPLY = &H200&
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_EFFECTS = &H100&
Private Const CF_ENABLEHOOK = &H8&
Private Const CF_ENABLETEMPLATE = &H10&
Private Const CF_ENABLETEMPLATEHANDLE = &H20&
Private Const CF_ENHMETAFILE = 14
Private Const CF_FIXEDPITCHONLY = &H4000&
Private Const CF_FORCEFONTEXIST = &H10000
Private Const CF_GDIOBJFIRST = &H300
Private Const CF_GDIOBJLAST = &H3FF
Private Const CF_HDROP = 15
Private Const CF_INITTOLOGFONTSTRUCT = &H40&
Private Const CF_LIMITSIZE = &H2000&
Private Const CF_LOCALE = 16
Private Const CF_MAX = 17
Private Const CF_METAFILEPICT = 3
Private Const CF_NOFACESEL = &H80000
Private Const CF_NOSCRIPTSEL = &H800000
Private Const CF_NOSIMULATIONS = &H1000&
Private Const CF_NOSIZESEL = &H200000
Private Const CF_NOSTYLESEL = &H100000
Private Const CF_NOVECTORFONTS = &H800&
Private Const CF_NOOEMFONTS = CF_NOVECTORFONTS
Private Const CF_NOVERTFONTS = &H1000000
Private Const CF_OEMTEXT = 7
Private Const CF_OWNERDISPLAY = &H80
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_PRINTERFONTS = &H2
Private Const CF_PRIVATEFIRST = &H200
Private Const CF_PRIVATELAST = &H2FF
Private Const CF_RIFF = 11
Private Const CF_SCALABLEONLY = &H20000
Private Const CF_SCREENFONTS = &H1
Private Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Private Const CF_SCRIPTSONLY = CF_ANSIONLY
Private Const CF_SELECTSCRIPT = &H400000
Private Const CF_SHOWHELP = &H4&
Private Const CF_SYLK = 4
Private Const CF_TIFF = 6
Private Const CF_TTONLY = &H40000
Private Const CF_UNICODETEXT = 13
Private Const CF_USESTYLE = &H80&
Private Const CF_WAVE = 12
Private Const CF_WYSIWYG = &H8000

Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal _
dwBytes As Long) As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (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" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As Long
Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenA" _
(ByVal lpString As String) As Long

Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _
As Long

Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) _
As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As _
Long) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat _
As Long, ByVal hMem As Long) As Long

Function ClipBoard_SetText(strCopyString As String) As Boolean
Dim hGlobalMemory As Long
Dim lpGlobalMemory As Long
Dim hClipMemory As Long

' Allocate moveable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(strCopyString) + 1)

' Lock the block to get a far pointer
' to this memory.
lpGlobalMemory = GlobalLock(hGlobalMemory)

' Copy the string to this global memory.
lpGlobalMemory = lstrcpy(lpGlobalMemory, strCopyString)

' Unlock the memory and then copy to the clipboard
If GlobalUnlock(hGlobalMemory) = 0 Then
If OpenClipboard(0&) <> 0 Then
Call EmptyClipboard
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
ClipBoard_SetText = CBool(CloseClipboard)
End If
End If
End Function

Function ClipBoard_GetText() As String
Dim hClipMemory As Long
Dim lpClipMemory As Long
Dim strCBText As String
Dim RetVal As Long
Dim lngSize As Long
If OpenClipboard(0&) <> 0 Then
' Obtain the handle to the global memory
' block that is referencing the text.
hClipMemory = GetClipboardData(CF_TEXT)
If hClipMemory <> 0 Then
' Lock Clipboard memory so we can reference
' the actual data string.
lpClipMemory = GlobalLock(hClipMemory)
If lpClipMemory <> 0 Then
lngSize = GlobalSize(lpClipMemory)
strCBText = Space$(lngSize)
RetVal = lstrcpy(strCBText, lpClipMemory)
RetVal = GlobalUnlock(hClipMemory)
' Peel off the null terminating character.
strCBText = Left(strCBText, InStr(1, strCBText, Chr$(0), 0) - 1)
Else
MsgBox "Could not lock memory to copy string from."
End If
End If
Call CloseClipboard
End If
ClipBoard_GetText = strCBText
End Function

Function CopyOlePiccy(Piccy As Object)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long

' Allocate moveable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(Piccy) + 1)

' Lock the block to get a far pointer
' to this memory.
lpGlobalMemory = GlobalLock(hGlobalMemory)


'Need to copy the object to the memory here

lpGlobalMemory = lstrcpy(lpGlobalMemory, Piccy)

' Unlock the memory.
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere2
End If

' Open the Clipboard to copy data to.
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If

' Clear the Clipboard.
X = EmptyClipboard()

' Copy the data to the Clipboard.
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
End Function
'********* Code End ************

[Welshgasman]

Well that looks like 64bit code to me, so would not have come from Access 2007, I believe that was 32bit only?

There does appear to be simpler ways?

A quick Google reveals https://learn.microsoft.com/en-us/of...-the-clipboard
From https://www.google.com/search?q=copy...hrome&ie=UTF-8

[CJ_London]

always better to copy/paste your code and use the # button to apply code tags. That way responders can highlight bits of code they want to reference. Also 'no longer works' doesn't help us to help you. What does it mean? you get an error (if so what is the error?), wrong thing copied? something else?

And have you compiled the code?

Looks like you have gone part way towards 64bit with using ptrSafe, but there is not a single longPtr to be seen. It may be that it is the case that all these functions don't require a longPtr, but I would check. Without checking, pretty sure your GlobalAlloc function has a longPtr parameter and returns a longPtr for example

As it is, your code will no doubt work in 32bit Access, but not 64bit. 365 defaults to 64bit on install so I would check your access version before going any further