MartyConnelly
martyconnelly at shaw.ca
Fri Jun 17 00:22:46 CDT 2005
You could use some rough code like this to snapshot either screen or
form to the clipboard
and then dump clipboard into word, I think it is all there.
Option Compare Database
Option Explicit
'_______________________________________________________
' 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 ErrorScreenReport()
'turn on reference to Microsoft Word Object Library
SnapPrintScreen
'SnapPrintForm
ErrorReportToWord
End Sub
Sub ErrorReportToWord()
Dim ObjWord As Word.Application
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
' 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 'copy clipboard
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
Option Compare Database
Option Explicit
'_______________________________________________________
' 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
Rocky Smolin - Beach Access Software wrote:
> I found that a screen print image was limited to the resolution of the
> screen. Copying a full page of a report from the screen just didn't
> provide the detail needed. Alt+Print Screen and Ctrl+V works good for
> dropping forms shots into a word doc.
>
> Rocky
>
> ----- Original Message ----- From: <dmcafee at pacbell.net>
> To: "Access Developers discussion and problem solving"
> <accessd at databaseadvisors.com>
> Sent: Thursday, June 16, 2005 3:53 PM
> Subject: RE: [AccessD] Print To Picture
>
>
>> So it's easier to use than Alt+Print Screen and Ctrl+V?
>>
>> I guess no editing.
>>
>> -----Original Message-----
>> From: accessd-bounces at databaseadvisors.com
>> [mailto:accessd-bounces at databaseadvisors.com]On Behalf Of Rocky Smolin -
>> Beach Access Software
>> Sent: Thursday, June 16, 2005 3:17 PM
>> To: Access Developers discussion and problem solving
>> Subject: Re: [AccessD] Print To Picture
>>
>>
>> 404 means a broken link. I'll send it to you off line, however.
>> It's from
>> a Russian guy who apparently has taken his site down. It installs
>> like a
>> printer and when you print to it it produces either a .PCX or .BMP
>> format
>> which you can insert into a word doc. I used it to put sample
>> reports into
>> a manual.
>>
>> Regards,
>>
>> Rocky Smolin
>> Beach Access Software
>> http://www.e-z-mrp.com
>> 858-259-4334
>>
>> ----- Original Message -----
>> From: "Jim Hewson" <JHewson at karta.com>
>> To: "Access Developers discussion and problem solving"
>> <accessd at databaseadvisors.com>
>> Sent: Thursday, June 16, 2005 2:50 PM
>> Subject: RE: [AccessD] Print To Picture
>>
>>
>>> Sounds like a useful tool.
>>> I've never heard of 404. I'd like to be able to get it.
>>> Thanks,
>>> Jim
>>>
>>> -----Original Message-----
>>> From: accessd-bounces at databaseadvisors.com
>>> [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Rocky Smolin
>>> - Beach Access Software
>>> Sent: Thursday, June 16, 2005 4:44 PM
>>> To: Access Developers discussion and problem solving
>>> Subject: Re: [AccessD] Print To Picture
>>>
>>> Never mind. Found the .exe on my old machine. But the original
>>> link is
>>> 404. So if anyone wants it, I've got it.
>>>
>>> Rocky
>>>
>>> ----- Original Message -----
>>> From: "Rocky Smolin - Beach Access Software" <bchacc at san.rr.com>
>>> To: <AccessD at databaseadvisors.com>
>>> Sent: Thursday, June 16, 2005 2:18 PM
>>> Subject: [AccessD] Print To Picture
>>>
>>>
>>> Dear List:
>>>
>>> I have a great utility on my old machine called print to picture.
>>> Installs
>>> like a printer and will print to a file which you can then copy into a
>>> word
>>> doc. I need it on my new machine but can't find it anymore. Anyone
>>> know
>>> where it is?
>>>
>>> TIA,
>>>
>>> Rocky Smolin
>>> Beach Access Software
>>> http://www.e-z-mrp.com
>>> 858-259-4334
>>> --
>>> AccessD mailing list
>>> AccessD at databaseadvisors.com
>>> http://databaseadvisors.com/mailman/listinfo/accessd
>>> Website: http://www.databaseadvisors.com
>>>
>>> --
>>> AccessD mailing list
>>> AccessD at databaseadvisors.com
>>> http://databaseadvisors.com/mailman/listinfo/accessd
>>> Website: http://www.databaseadvisors.com
>>> --
>>> AccessD mailing list
>>> AccessD at databaseadvisors.com
>>> http://databaseadvisors.com/mailman/listinfo/accessd
>>> Website: http://www.databaseadvisors.com
>>>
>>
>> --
>> AccessD mailing list
>> AccessD at databaseadvisors.com
>> http://databaseadvisors.com/mailman/listinfo/accessd
>> Website: http://www.databaseadvisors.com
>>
>> --
>> AccessD mailing list
>> AccessD at databaseadvisors.com
>> http://databaseadvisors.com/mailman/listinfo/accessd
>> Website: http://www.databaseadvisors.com
>>
>
--
Marty Connelly
Victoria, B.C.
Canada