Lembit Soobik
lembit.soobik at t-online.de
Thu Feb 17 05:37:31 CST 2005
Thank you so much, Marty,
I will try this out later today.
And thanks a lot for the offer. Yes, I would appreciate the test mdb
my email is lembit.soobik at t-online.de
Lembit Soobik
----- Original Message -----
From: "MartyConnelly" <martyconnelly at shaw.ca>
To: "Discussion of Hardware and Software issues" <dba-tech at databaseadvisors.com>
Sent: Wednesday, February 16, 2005 11:16 PM
Subject: Re: [dba-Tech] Save screenshot as JPG
> Lembit Soobik wrote:
>
> >Hi everybody,
> >
> >is there a way to make a screenshot from within Access and then save that as
> >.JPG (or :BMP)?
> >kind of self-portrait of an Acces form. :)
> >
> >I think that it should be possible to use SENDKEYS to get the screenshot. but
> >then how to save it as a picture on the disk?
> >
> >thanks for you help
> >
> >Lembit Soobik
> >
> >
>
> Here is some relevant code that copies either a snapshot screen or form
> to the clipboard
> and then dumps this as a bmp into a word document along with some other
> info like
> the tasklist of processes. I believe you can get at clipboard in higher
> versions of Access in an easier fashion
> but this was written a while ago for 97
> The sub ErrorScreenReport is the main call
> If you want a test mdb I have one with a lot of my ancillary calls
> stripped out like determining OS version etc
> for an emailable error report.
>
>
> Sub ErrorReportToWord()
> 'Dim ObjWord As Word.Application
> Dim ObjWord As Object
> Dim temp As String
> Dim strFileName As String
> Dim strErrDesc As String
> Dim strLoadTaskList As String
> Dim appPathAccess As String
> ' grab the Task List
> strLoadTaskList = LoadTaskList()
> ' On Error Resume Next
>
> ' Set ObjWord = New Word.Application
> Set ObjWord = CreateObject("Word.Application")
> ' Disable command button to prevent object being recreated
> ' If you have an error in here, it will litter memory with copies of word
> ' so put in error handling
>
> ObjWord.Documents.Add
> ObjWord.Selection.Paste
>
> strErrDesc = "Error No: " & Err.Number & "; Description: " & Err.Description
> 'no range selected so text placed at end of document
> ObjWord.Application.Selection.Font.Size = 14
> ObjWord.Application.Selection.Font.Bold = True
> strErrDesc = strErrDesc & " Module name = ..." & vbCrLf & vbCrLf
> ObjWord.Application.Selection.Font.Size = 10
> ObjWord.Application.Selection.Font.Bold = True
> strErrDesc = strErrDesc & strLoadTaskList
> ObjWord.ActiveDocument.Content.InsertAfter Text:=strErrDesc
>
> ' Saves report with a new filename
> ' Name of report file, change path to whatever is applicable
> appPathAccess = CurrentDBDir
> strFileName = appPathAccess & "ErrorReport"
> strFileName = strFileName & Format(Now, "yyyymmddhhmmss") & ".doc"
>
> ObjWord.ActiveDocument.SaveAs (strFileName)
> ' Quit Word
> ObjWord.Documents.Close
> ObjWord.Quit
> ' Inform user that report is created
> MsgBox "Error Report Created in File" & vbCrLf & strFileName
> ' Clear our pointer to word
> Set ObjWord = Nothing
> End Sub
>
>
> 'Determining Which Tasks Are Running
>
> 'With the Microsoft Windows operating system,
> 'you can run any number of applications simultaneously.
> 'Occasionally, you may need to determine which tasks are currently being
> 'run.
> 'This can be accomplished by using several Windows application programming
> 'interface
> '(API) functions.
> 'To find the names of all currently executing tasks,
> 'you must first determine the handle of the window that is currently
> 'at the top of the z-order. This, of course, would be the window of your
> 'own Microsoft Visual Basic application.
> 'You can use the Windows API GetWindow function to retrieve the handle
> 'of your application's window with the statement:
>
> ' CurrWnd = GetWindow(Form1.hwnd, GW_HWNDFIRST)
> ' To use in Access replace with the following
> ' parent_hwnd = FindWindow(vbNullString, "Microsoft Access")
> 'The first argument of the GetWindow function is the handle of the window
> 'that is at the top of the z-order. In this case, this is the handle of
> 'Form1.
>
> 'The second argument of the GetWindow function specifies the window
> 'you want to retrieve the handle for.
> 'This argument can have one of the following values:
>
> ' GW_CHILD Retrieve the handle for the child window.
> ' GW_HWNDFIRST Retrieve the handle for the window at the top of the z-
> 'order.
> ' GW_HWNDLAST Retrieve the handle for the window at the bottom of the z-
> 'order.
> ' GW_HWNDNEXT Retrieve the handle of the window below the specified window
> 'in the z-order.
> ' GW_HWNDPREV Retrieve the handle of the window above the specified window
> 'in the z-order.
> ' GW_OWNER Retrieve the handle of the window that owns the specified
> 'window, if any.
>
> 'After you have retrieved the application's window handle,
> 'you can use the Windows API GetParent function to retrieve this window's
> 'child window handle. Next, you call the Windows API GetWindowText and
> 'GetWindowTextLength functions to retrieve the text in the window's title
> 'bar
> 'and the length of this text, respectively. You can then use the text string
> 'in your own application. For example, you can save the title bar text
> 'to a List Box control.
>
> 'All of the above steps are repeated until you have processed all running
> 'tasks.
> 'You know that you have gone through each task when the current window is
> 'that'of your own application.
>
>
> Function LoadTaskList() As String
> Dim CurrWnd As Long
> Dim Length As Long
> Dim TaskName As String
> Dim Parent As Long
> Dim parent_hwnd As Long
> Dim strMyTaskList As String
> strMyTaskList = " Task List " & vbCrLf
>
> ' This line below works from VB form
> 'CurrWnd = GetWindow(Form1.hwnd, GW_HWNDFIRST)
> ' get Parent Window Handle
> parent_hwnd = FindWindow(vbNullString, "Microsoft Access")
> If parent_hwnd = 0 Then
> MsgBox "Access Not Found"
> Exit Function
> End If
> 'SetFocusAPI parent_hwnd
> CurrWnd = parent_hwnd
> While CurrWnd <> 0
> Parent = GetParent(CurrWnd)
> Length = GetWindowTextLength(CurrWnd)
> TaskName = Space$(Length + 1)
> Length = GetWindowText(CurrWnd, TaskName, Length + 1)
> TaskName = Left$(TaskName, Len(TaskName) - 1)
>
> If Length > 0 Then
> 'If TaskName <> Me.Caption Then
> 'If TaskName <> "Microsoft Access" Then
> 'List1.AddItem TaskName
> strMyTaskList = strMyTaskList & TaskName & vbCrLf
> Debug.Print TaskName
> 'End If
> End If
> CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
>
> DoEvents
> Wend
> LoadTaskList = strMyTaskList
> End Function
> '
> Function CurrentDBDir() As String
> ' get Current Database Path string
> Dim strDBPath As String
> Dim strDBFile As String
> strDBPath = CurrentDb.Name
> strDBFile = Dir(strDBPath)
> CurrentDBDir = Left(strDBPath, Len(strDBPath) - Len(strDBFile))
> End Function
>
>
> '_______________________________________________________
> ' Snap a picture of the screen and send error messages,
> ' screen picture and tasklist to a word document
> '________________________________________________________
>
> Private Const VK_LWIN = &H5B 'Left window button
> Private Const VK_RETURN = &HD 'ENTER key
> Private Const VK_SHIFT = &H10 'SHIFT key
> Private Const VK_CONTROL = &H11 'CTRL key
> Private Const VK_MENU = &H12 'ALT key
> Private Const VK_PAUSE = &H13 'PAUSE key
> Private Const VK_CAPITAL = &H14 'CAPS LOCK key
> Private Const VK_SNAPSHOT = &H2C 'Print Screen
> Private Const VK_APPS = &H5D
> 'Applications key on a Microsoft Natural Keyboard
> 'from http://support.microsoft.com/view/dev.asp?kb=242971
>
> Const GW_HWNDFIRST = 0
> Const GW_HWNDNEXT = 2
> Private Const KEYEVENTF_KEYUP = &H2
>
> Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
> ByVal bScan As Byte, ByVal dwflags As Long, ByVal dwExtraInfo As Long)
> Private Declare Function GetWindow Lib "user32" _
> (ByVal hwnd As Long, ByVal wCmd As Long) As Long
> Private Declare Function GetParent Lib "user32" _
> (ByVal hwnd As Long) As Long
> Private Declare Function GetWindowTextLength Lib _
> "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
> Private Declare Function GetWindowText Lib "user32" _
> Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal _
> lpString As String, ByVal cch As Long) As Long
> Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
> (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
> Private Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" _
> (ByVal hwnd As Long) As Long
>
> Sub OpenWindowsHelp()
> ' Open the Windows Help
> '
> ' You can use the same technique to programmatically "press" any other
> ' key, including Shift, Ctrl, Alt and keys combinations that can't be
> ' simulated through SendKeys
> ' programmatically press the Windows key
> keybd_event VK_LWIN, 0, 0, 0
> ' then press and then release the F1 key
> keybd_event vbKeyF1, 0, 0, 0
> keybd_event vbKeyF1, 0, KEYEVENTF_KEYUP, 0
> ' and finally release the Windows Key
> keybd_event VK_LWIN, 0, KEYEVENTF_KEYUP, 0
> End Sub
> Sub CloseAllWindows()
> ' Minimize all open windows
> 'Const acaltMask
> ' programmatically press the Windows key
> keybd_event VK_LWIN, 0, 0, 0
> ' then press and then release the M key
> keybd_event vbKeyM, 0, 0, 0
> keybd_event vbKeyM, 0, KEYEVENTF_KEYUP, 0
> ' and finally release the Windows Key
> keybd_event VK_LWIN, 0, KEYEVENTF_KEYUP, 0
> End Sub
>
> Sub SnapPrintForm()
> 'use the following code inside form or focused window
> 'to simulate the Alt / PrintScreen = key combination:
> 'If form popup in Access will capture form
> ' programmatically press the ALT key
> ' keybd_event VK_MENU, 0, 0, 0
> ' then press and then release the PrtScreen key
> keybd_event VK_SNAPSHOT, 1, 0, 0
> DoEvents
> ' keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
> ' and finally release the ALT Key
> ' keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
>
> End Sub
> Sub SnapPrintScreen()
> 'To print the entire screen (rather than the current focused window
> 'programmatically press the ALT key
> 'keybd_event VK_MENU, 0, 0, 0
> ' then press and then release the PrtScreen key
> keybd_event VK_SNAPSHOT, 0, 0, 0
> DoEvents
> 'keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
> ' and finally release the ALT Key
> 'keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
> ' The second argument for the keybd_event call is the hardware scan code,
> ' and, in this case, you could use the value 1. This may have to change
> ' with Win 2000
> ' However, applications should not use this scan code according to Microsoft
> ' The screen is now captured in the clipboard as a bmp
> End Sub
> Sub SnapZoom()
> 'use the following code inside form or focused window
> 'to simulate the F/.Shift = key combination:
>
> ' then press and then release the F2 Shift key
> 'order of pressing important
> keybd_event vbKeyShift, 0, 0, 0
> keybd_event vbKeyF2, 0, 0, 0
>
>
> keybd_event vbKeyF2, 0, KEYEVENTF_KEYUP, 0
> 'weird things happen if you don't up the shiftkey looks like capslock
> keybd_event vbKeyShift, 0, KEYEVENTF_KEYUP, 0
>
> DoEvents
>
> End Sub
>
> --
> Marty Connelly
> Victoria, B.C.
> Canada
>
>
>
> _______________________________________________
> dba-Tech mailing list
> dba-Tech at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/dba-tech
> Website: http://www.databaseadvisors.com