Solved

Accessing/checking the clipboard using MS Access 2003

Posted on 2009-04-09
2
976 Views
Last Modified: 2013-11-27
I am trying to find a way to check if the clipboard has anything on it, without crashing Access in the process.

I am using InternetExplorer application object to access a specific page, paste in certain data, then wait for the results.
I am able to select all and copy the entire page so it can be pasted into MS excel.  From there I pull it into access and use the results.  One problem is that Access moves to fast after the page is loaded and the select all does not happen all the time and when it does the copy does not finish before it needs to be pasted into excel.  So, rather than trap for the error when I try to paste, I want to check to see if the clipboard has anything on it.  I have APIs to get data from the clipboard, send data to the clipboard, and clear the clipboard.  When I try to get the data from the clipboard to check to see if it is blank, Access locks up.   Attached is the code I am using for accessing the clipboard.
Option Compare Database

Option Explicit
 

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

   As Long

Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _

   As Long

Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _

   ByVal dwBytes As Long) As Long

Declare Function CloseClipboard Lib "User32" () As Long

Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _

   As Long

Declare Function EmptyClipboard Lib "User32" () As Long

Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _

   ByVal lpString2 As Any) As Long

Declare Function SetClipboardData Lib "User32" (ByVal wFormat _

   As Long, ByVal hMem As Long) As Long

Declare Function GetClipboardData Lib "User32" (ByVal wFormat As _

   Long) As Long
 
 

Public Const GHND = &H42

Public Const CF_TEXT = 1

Public Const MAXSIZE = 4096
 

Function ClipBoard_SetData(MyString As String)

   Dim hGlobalMemory As Long, lpGlobalMemory As Long

   Dim hClipMemory As Long, X As Long
 

   ' Allocate moveable global memory.

   '-------------------------------------------

   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 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, MyString)
 

   ' 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
 

Function ClipBoard_GetData()

   Dim hClipMemory As Long

   Dim lpClipMemory As Long

   Dim MyString As String

   Dim RetVal As Long
 

   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
 

Function ClipBoard_CheckData() As Boolean

   Dim hClipMemory As Long

   Dim lpClipMemory As Long

   Dim MyString As String

   Dim RetVal As Long
 

   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 - 5)

      RetVal = GlobalUnlock(hClipMemory)

      If MyString <> "" Then

         RetVal = lstrcpy(MyString, lpClipMemory) ' This line causes a fatal crash.

         ClipBoard_CheckData = True

         'RetVal = CloseClipboard()

         'Exit Function

      Else

         ClipBoard_CheckData = False

      End If

   Else

      MsgBox "Could not lock memory to copy string from."

   End If
 

OutOfHere:
 

   RetVal = CloseClipboard()

   'ClipBoard_GetData = False

End Function

Open in new window

0
Comment
Question by:masterjojobinks
2 Comments
 
LVL 16

Assisted Solution

by:Chuck Wood
Chuck Wood earned 200 total points
ID: 24107599
I have used this code without problems in the past. You might want to try it and see if it works for you.
Attribute VB_Name = "basClipboard"

Option Compare Database

Option Explicit
 

' 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 Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal _

  dwBytes As Long) As Long

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

  As Long

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

  As Long

Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _

  ByVal lpString2 As Any) As Long

Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _

  (ByVal lpString As String) As Long

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

  As Long

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) _

  As Long

Private Declare Function CloseClipboard Lib "user32" () As Long

Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat 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
 

Function ClipBoardSetText(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)

      ClipBoardSetText = CBool(CloseClipboard)

    End If

  End If

End Function
 

Function ClipBoardGetText() 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

  ClipBoardGetText = 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

Open in new window

0
 
LVL 8

Accepted Solution

by:
masterjojobinks earned 0 total points
ID: 24157315
Sorry, that did not work, either.  I just fixed it by traping the error and going back and redoing it.
thanks though.
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Most if not all databases provide tools to filter data; even simple mail-merge programs might offer basic filtering capabilities. This is so important that, although Access has many built-in features to help the user in this task, developers often n…
The first two articles in this short series — Using a Criteria Form to Filter Records (http://www.experts-exchange.com/A_6069.html) and Building a Custom Filter (http://www.experts-exchange.com/A_6070.html) — discuss in some detail how a form can be…
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now