Word VBA screen capture

[PANTECH]

How do I capture a screen shot of my user form in Word 7 VBA and email the screen shot as an outlook email attachment? If anyone could provide that code it would be deeply appreciated.

[Rudi]

Hi,

Welcome the the lounge

To capture a screenshot, you can simply press the Print Screen button on your keyboard. This captures the current screen on your Windows clipboards. From there you can open Windows Paint, paste the image from the clipboard into the page and save it as a .jpg or .bmp. Once its a picture it can be attached or inserted into a mail.

Personally I like using a dedicated screen capture application. See http://www.screenpresso.com/ or Google for any free screen capturer.

[HansV]

To capture a screenshot of the active userform, press Alt+PrintScreen instead of PrintScreen.

[PANTECH]

Actually I wanted something more automatic. The below code sends the email but I need code to take the user form screen shot.

Code: Select all

Private Sub commandButton1_Click()
Dim OL               As Object
Dim EmaiItem         As Object
Dim Doc              As Document
 

Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save


With EmailItem
    .Subject = "Walkaround"
    .To = "my email address"
    .Importance = olImportanceNormal
    .Attachments.Add Doc.FullName
    .Send
End With

Application.ScreenUpdating = True

Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing

Application.ActiveDocument.Close

End Sub

[Rudi]

Reading your question again, I notice you are referring to doing a screen capture with Word VBA. You may want to refer to this web page and test the code to see if it can work for you. As for me, this is way beyond my level of VBA expertise...

See: http://www.your-save-time-and-improve-q ... e-vba.html

[HansV]

To take a screenshot, copy the following code into a new standard module:

Code: Select all

Private Declare Sub keybd_event Lib "user32" _
   (ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long)

Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_LMENU = &HA4

Sub AltPrintScreen()
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0 ' key down
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
End Sub

And here is some code for a command button cmdScreenshot on the userform. It doesn't create an attachment (it is quite difficult to automate saving a screenshot to a reasonable format), but inserts the screenshot into the body of the e-mail:

Code: Select all

Private Sub cmdScreenshot_Click()
    Dim olApp As Object
    Dim olMsg As Object
    Dim olRec As Object
    Dim olDoc As Document

    On Error Resume Next
    Set olApp = GetObject(Class:="Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject(Class:="Outlook.Application")
        If olApp Is Nothing Then
            MsgBox "Can't start Outlook!", vbCritical
            Exit Sub
        End If
        ' The following line may help
        'olApp.Session.Logon
    End If
    On Error GoTo ErrHandler

    Call AltPrintScreen
    DoEvents
    Set olMsg = olApp.CreateItem(0) ' 0 = olMailItem
    Set olRec = olMsg.Recipients.Add("someone@somewhere.com")
    olMsg.Subject = "Test Message"
    ' Display message - this is necessary to paste
    olMsg.Display
    Set olDoc = olApp.ActiveInspector.WordEditor
    olDoc.Content.Paste
    olDoc.Content.InsertParagraphAfter
    olDoc.Content.InsertAfter "Yours sincerely, Me"
    ' Send it
    olMsg.Send

ExitHandler:
    On Error Resume Next
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[PANTECH]

Thanks, the email arrived but no screen shot.

[HansV]

It works for me, but trying to take a screenshot from VBA and to paste it is notoriously flaky.

Why do you need a screenshot of a userform? Can't you assemble the required information directly in the e-mail message?

[PANTECH]

The top of the user form has a diagram. Once the data is entered in the bottom part of the user form it is then emailed as an attachment. The user would then save the screen shot and open it in Sketch book Pro. Once there he would make remarks on the diagram then save the file and forward it to other users.

[HansV]

For what it's worth, here is the result I get (Office 2010 SP1 32-bit on Windows 7 Enterprise 64-bit; also tested on Windows 7 Home Premium 64-bit):

S291.png

[PANTECH]

So to get this in the body of the email you used the code from your previous thread? If so where did you place the command button code in a second module or in the code for the user form?

[HansV]

The command button is the one you see in my previous reply, and the code to create the screenshot and e-mail it is the On Click event procedure for that command button in the userform module.

[PANTECH]

It most be me because this is not working. Do I remove what I had before your suggestion (which you see below) and replace this with your code? This is currently under command button 1 click.


Private Sub commandButton1_Click()
Dim OL As Object
Dim EmaiItem As Object
Dim Doc As Document


Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save


With EmailItem
.Subject = "Walkaround"
.To = "my email address"
.Importance = olImportanceNormal
.Attachments.Add Doc.FullName
.Send
End With

Application.ScreenUpdating = True

Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing

Application.ActiveDocument.Close

End Sub

[HansV]

You should replace the code you now have with the code that I posted, then modify the code as follows:
- Change cmdScreenshot_Click to commandButton1_Click (or rename commandButton1 to cmdScreenshot).
- Change the e-mail address of the recipient to the one you want to use.
- Change the subject to the one you want to use.
- Change the following line as needed, and add more such lines if desired.

Code: Select all

    olDoc.Content.InsertAfter "Yours sincerely, Me"

[PANTECH]

Hans,

Tried it had high hopes but when I did the debug I received Complie error sub or function not defined at the line Call AltPrintScreen.

[HansV]

Here is my test document.

ScreenshotDemo.docm

[PANTECH]

No problem with the debug but when I ran it - depressed the submit key and a window popped that stated... Application- defined or object- defined error. Below is the code I have in the userform.

Code: Select all

Option Explicit


Private Sub CommandButton1_Click()
    Dim olApp As Object
    Dim olMsg As Object
    Dim olRec As Object
    Dim olDoc As Document

    On Error Resume Next
    Set olApp = GetObject(Class:="Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject(Class:="Outlook.Application")
        If olApp Is Nothing Then
            MsgBox "Can't start Outlook!", vbCritical
            Exit Sub
        End If
        
    End If
    On Error GoTo ErrHandler

    Call AltPrintScreen
    DoEvents
    Set olMsg = olApp.CreateItem(0)
    Set olRec = olMsg.Recipients.Add("my email address")
    olMsg.Subject = "WALKAROUND"
    
    olMsg.Display
    Set olDoc = olApp.ActiveInspector.WordEditor
    olDoc.Content.Paste
    olDoc.Content.InsertParagraphAfter
    olDoc.Content.InsertAfter "Here you go"
    
    olMsg.Send

ExitHandler:
    On Error Resume Next
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub


Private Sub SpinButton1_Change()
    TextBox1.Text = SpinButton1.Value
    SpinButton1.Min = 0
    SpinButton1.Max = 9
End Sub

Private Sub SpinButton2_Change()
    TextBox2.Text = SpinButton2.Value
    SpinButton2.Min = 0
    SpinButton2.Max = 9
End Sub

Private Sub SpinButton3_Change()
    TextBox3.Text = SpinButton3.Value
    SpinButton3.Min = 0
    SpinButton3.Max = 9
End Sub

Private Sub SpinButton4_Change()
    TextBox4.Text = SpinButton4.Value
    SpinButton4.Min = 0
    SpinButton4.Max = 9
End Sub


Private Sub UserForm_Click()

End Sub

Code in module 1

Code: Select all

Option Explicit

Private Declare Sub keybd_event Lib "user32" _
   (ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long)

Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_LMENU = &HA4


Sub AltPrintScreen()
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0 ' key down
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
End Sub

[PANTECH]

Hans,

I get the same thing with your demo.

[HansV]

Try having Outlook already active before you run the code. Or uncomment the line

Code: Select all

        'olApp.Session.Logon

by removing the apostrophe.

[PANTECH]

You are awesome! I do have some more things I want to do with this userform but I will start a new post.