Take screenshot of userform and paste into email body

johnsonk

Board Regular
Joined
Feb 4, 2019
Messages
172
Hi,
I am try to paste a screenshot of a userform in to an email body but can not get it work could some take a look at my code and see if I have missed something.

VBA Code:
Dim OutApp As Object

Dim OutMail As Object


'Shift-Print Screen

Application.SendKeys "(%{1068})"


DoEvents


On Error Resume Next


'Prepare the email

Set OutApp = CreateObject("Outlook.Application")

OutApp.Session.Logon

Set OutMail = OutApp.CreateItem(0)


On Error Resume Next


With OutMail

.To = "myemail.co.uk"

.Subject = "TEST"


Application.SendKeys "(^v)"

.Send


End With

On Error GoTo 0


OutApp.Session.Logoff

Set OutMail = Nothing

Set OutApp = Nothing

Regards

Also posted on Ozgrid:
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Try this code, calling the Screenshot_Active_Window_Send_Outlook_Email routine from your userform code.

VBA Code:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Private Declare PtrSafe Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
#Else
    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 MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
#End If

Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12


Public Sub Screenshot_Active_Window_Send_Outlook_Email()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim OutInsp As Object
    Dim wdDoc As Object
    Dim OutRng As Object
   
    'Capture active window to clipboard
   
    AltPrintScreen
   
    On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
    On Error GoTo 0
   
    'Create and send Outlook email with clipboard pasted
   
    Set OutMail = OutApp.CreateItem(0)
   
    With OutMail
       
        .To = "email@address.com"
        .CC = ""
        .BCC = ""
        .Subject = Time & " Userform screenshot"
       
        Set OutInsp = .GetInspector
        Set wdDoc = OutInsp.WordEditor
        Set OutRng = wdDoc.Range
        OutRng.Collapse 1
        OutRng.Paste
       
        .Display
        DoEvents
        .Send
           
    End With
  
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set OutInsp = Nothing
    Set wdDoc = Nothing
    Set OutRng = Nothing
   
End Sub
 
Upvote 0
John,

I have a working code for the email from the site ozgrid but I would like to thank you for your time in providing the code.

Regards
 
Upvote 0

Forum statistics

Threads
1,213,539
Messages
6,114,221
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top