MartyConnelly
martyconnelly at shaw.ca
Wed Feb 16 16:16:11 CST 2005
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