Login or Sign Up to become a member!
LessThanDot Site Logo

LessThanDot

A Technical Community for IT Professionals

Less Than Dot is a community of passionate IT professionals and enthusiasts dedicated to sharing technical knowledge, experience, and assistance. Inside you will find reference materials, interesting technical discussions, and expert tips and commentary. Once you register for an account you will have immediate access to the forums and all past articles and commentaries.

LTD Social Sitings

Lessthandot twitter Lessthandot Linkedin Lessthandot facebook Lessthandot rss

Note: Watch for social icons on posts by your favorite authors to follow their postings on these and other social sites.

Highly Rated Users

Forum
No Posts Rated

Top 50
Given
Received

Links

Wiki
Blog

Forum Statistics

Users
Members:
1507
Members Online:
1
Guests Online:
2

Total Post History
Posts:
80036
Topics:
18306

7-Day Post History
New Posts:
6
New Topics:
2
Active Topics:
4

Our newest member
joegollakner

Other

FAQ
All times are UTC [ DST ]

Google Ads

Capture an Access Error in Some Other Access App

Forum rules
Please:
- include the version of Access you are using.
- include the exact details of any error.
- highlight or draw attention to the line of code where the error occurred.
- read the FAQs, where these and other points are mentioned:
Topic565: General FAQ for Access
Please wait...

Capture an Access Error in Some Other Access App

Postby Remou on Mon Sep 28, 2009 9:31 pm

Access Version: 2000

Someone asked "This application is third party application. I can not change any codes. lately It started to have some errors. I have a timer to run this application and I just wondering if it was possible to check if this application has an runtime error from remote computer or from different program" (http://stackoverflow.com/questions/1485 ... 68#1485968)

And it occurred to me that it just might be possible, but probably not a good idea. I spent far too much time on this, so I thought I would post it here, in case there are any ideas that may be of use.

  1. Private Const CF_TEXT = 1
  2.  
  3. Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  4. Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
  5.  
  6. Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
  7. Declare Function CloseClipboard Lib "user32" () As Long
  8. Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
  9. Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
  10. Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Long, ByVal ByteLen As Long)
  11.  
  12. Sub LogError(strError)
  13. Const ForAppending = 8
  14. Dim strPath As String
  15. Dim fs As Object
  16. Dim a As Object
  17.    
  18.     strPath = "C:\Docs"
  19.    
  20.     Set fs = CreateObject("Scripting.FileSystemObject")
  21.     If fs.FileExists(strPath & "\ErrorLog.txt") = True Then
  22.         Set a = fs.OpenTextFile(strPath & "\ErrorLog.txt", ForAppending)
  23.     Else
  24.         Set a = fs.CreateTextFile(strPath & "\ErrorLog.txt")
  25.     End If
  26.     a.WriteLine Date + Time & " " & strError
  27.     a.Close
  28.    
  29.     Set fs = Nothing
  30. End Sub
  31.  
  32. Sub ReadClipboard()
  33.     Dim hStrPtr As Long, lLength As Long, sBuffer As String
  34.     Dim fs As Object
  35.    
  36.     Set fs = CreateObject("Scripting.FileSystemObject")
  37.    
  38.     OpenClipboard Application.hWndAccessApp
  39.    
  40.     hStrPtr = GetClipboardData(CF_TEXT)
  41.     If hStrPtr <> 0 Then
  42.         lLength = lstrlen(hStrPtr)
  43.         If lLength > 0 Then
  44.             sBuffer = Space(lLength)
  45.             CopyMemory ByVal sBuffer, ByVal hStrPtr, lLength
  46.             LogError sBuffer
  47.         End If
  48.     End If
  49.     CloseClipboard
  50. End Sub
  51.  
  52. Private Sub CopyError()
  53. Dim bHwnd As Long
  54. Dim s
  55.  
  56.     'Find the error window
  57.     bHwnd = FindWindow("#32770", "Microsoft Visual Basic")
  58.    
  59.     If bHwnd = 0 Then
  60.         'No error
  61.         Exit Sub
  62.     Else
  63.    
  64.         s = SetForegroundWindow(bHwnd)
  65.         If s = 0 Then
  66.             'Problem
  67.             Exit Sub
  68.         Else
  69.             ' There will be some lag before this window is actually in the foreground, so, give it a
  70.             ' little CPU to move it to the front
  71.             DoEvents
  72.             DoEvents
  73.             DoEvents
  74.            
  75.             'Copy the error message to clipboard
  76.             SendKeysWS "^C", True
  77.             ReadClipboard
  78.         End If
  79.     End If
  80. End Sub
  81.  
  82. Function SendKeysWS(SendString, Wait)
  83. 'Work-around for Vista
  84.  
  85. Dim WshShell As Object
  86. Dim i
  87.     Set WshShell = CreateObject("WScript.Shell")
  88.     WshShell.SendKeys SendString, Wait
  89. End Function
  90.  
Stop quoting laws to us. We carry swords.
User avatar
Remou
LTD Admin
LTD Admin
LTD Gold - Rating: 937LTD Gold - Rating: 937LTD Gold - Rating: 937LTD Gold - Rating: 937LTD Gold - Rating: 937
LTD Gold - Rating: 937LTD Gold - Rating: 937LTD Gold - Rating: 937LTD Gold - Rating: 937LTD Gold - Rating: 937
LTD Gold - Rating: 937
 
Posts: 5253
Joined: Sun Oct 14, 2007 11:26 am
Unrated

Re: Capture an Access Error in Some Other Access App

Postby Chopstik on Fri Oct 09, 2009 4:08 pm

Remou,

This may be a worthwhile blog post (if you haven't already done it).
Reason and free inquiry are the only effectual agents against error; they are the natural enemies of error and of error only.

Thomas Jefferson

WAR IS PEACE • FREEDOM IS SLAVERY • IGNORANCE IS STRENGTH

Winston Smith
User avatar
Chopstik
LTD Admin
LTD Admin
LTD Silver - Rating: 340LTD Silver - Rating: 340LTD Silver - Rating: 340LTD Silver - Rating: 340LTD Silver - Rating: 340
LTD Silver - Rating: 340
 
Posts: 4175
Joined: Thu Oct 11, 2007 2:04 pm
Unrated

Re: Capture an Access Error in Some Other Access App

Postby Remou on Fri Oct 09, 2009 4:37 pm

No I haven't - it would never occur to me that my vague ramblings would fit in with that den of expertise. :)
Stop quoting laws to us. We carry swords.
User avatar
Remou
LTD Admin
LTD Admin
LTD Gold - Rating: 937LTD Gold - Rating: 937LTD Gold - Rating: 937LTD Gold - Rating: 937LTD Gold - Rating: 937
LTD Gold - Rating: 937LTD Gold - Rating: 937LTD Gold - Rating: 937LTD Gold - Rating: 937LTD Gold - Rating: 937
LTD Gold - Rating: 937
 
Posts: 5253
Joined: Sun Oct 14, 2007 11:26 am
Unrated

Re: Capture an Access Error in Some Other Access App

Postby Chopstik on Fri Oct 09, 2009 5:11 pm

Remou wrote:No I haven't - it would never occur to me that my vague ramblings would fit in with that den of expertise. :)

Don't worry... If mine are fit to print, I can assure you that you will have no problems fitting in with that den of expertise. :D
Reason and free inquiry are the only effectual agents against error; they are the natural enemies of error and of error only.

Thomas Jefferson

WAR IS PEACE • FREEDOM IS SLAVERY • IGNORANCE IS STRENGTH

Winston Smith
User avatar
Chopstik
LTD Admin
LTD Admin
LTD Silver - Rating: 340LTD Silver - Rating: 340LTD Silver - Rating: 340LTD Silver - Rating: 340LTD Silver - Rating: 340
LTD Silver - Rating: 340
 
Posts: 4175
Joined: Thu Oct 11, 2007 2:04 pm
Unrated