Vbscript Printscreen to MSpaint

Question

Take a screen shot of the active window.

Set Wshshell=CreateObject("Word.Basic")
WshShell.sendkeys"%{prtsc}"
WScript.Sleep 1500

Run Mspaint and paste.

set Wshshell = WScript.CreateObject("WScript.Shell")
Wshshell.Run "mspaint"
WScript.Sleep 500

WshShell.AppActivate "Paint"
WScript.Sleep 500

WshShell.sendkeys "^(v)"
WScript.Sleep 1500

Here, the operation for Taking screenshot of active window works Fine.. Also, it starts with mspaint, but the content is not been pasted in the paint file.

Answer 1

Your ^V parameter to .Sendkeys is wrong, it should be:

WshShell.sendkeys "^v"

The .Sleep after .AppActivate seems to be critical; I couldn't get it to 'work' until I increased the sleeping time:

WshShell.AppActivate "Paint"
WScript.Sleep 5000

Your problem prooves that .Sendkeys is not reliable. Look here, especially the posting of Moby Disk to think about other strategies.

Answer 2

In case that you want to achieve something like "PrintScreen's Save-as-JPG", here's my code:

' ----------------------------------------------------------------------
' Clipboard to JPG    ...using Word.Basic and Excel
' ----------------------------------------------------------------------
  Dim DosBasic : Set DosBasic = CreateObject("Word.Basic")
  Dim XLS      : Set XLS      = CreateObject("Excel.Application")
  Dim T0       : T0           = Now


  Call GetScreenshot
  Call Ding
  Call MakeFolderIfNotExist(ScreenshotFolder & "\" & CurrDate)
  Call StoreClipboard(CurrDate & "\" & CurrTime & ".jpg")

  XLS.Application.Quit



' ----------------------------------------------------------------------
  Sub MakeFolderIfNotExist(ByVal FolderName)
' ----------------------------------------------------------------------
  Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
  if not FSO.FolderExists(FolderName) then FSO.CreateFolder(FolderName)
  End Sub



' Uses less known Word.Basic to correctly send (Alt+)PrintScreen.
' Unfortunately, the Word.Basic takes SEVERAL seconds to load
' ----------------------------------------------------------------------
  Sub GetScreenshot
' ----------------------------------------------------------------------
  'Dim DosBasic : Set DosBasic = CreateObject("Word.Basic")
  'DosBasic.SendKeys "{1068}"           ' = Printscreen     = entire screen
  DosBasic.SendKeys "%{prtsc}"        ' = Alt+PrintScreen = only active window
  End Sub



' Uses Excel and its mighty Chart object, to create Exportable JPG image
' ----------------------------------------------------------------------
  Sub StoreClipboard(ByVal Filename)
' ----------------------------------------------------------------------
  Const xlLandscape = 2  ' Landscape page
  Const xlPortrait  = 1  ' Portrait page

  'Dim XLS   : Set XLS = CreateObject("Excel.Application")
  Dim Sheet : Set Sheet = XLS.Workbooks.Add
  Dim Chart : Set Chart = XLS.Charts.Add

  Const ScreenshotFolder = "C:\Temp\Screenshots"
  Call MakeFolderIfNotExist(ScreenshotFolder)

  XLS.Visible = False
  XLS.ActiveSheet.PageSetup.Orientation = xlLandscape
  XLS.ActiveWindow.Zoom = 100
  Chart.Paste
  Chart.Export ScreenshotFolder & "\" & Filename
  XLS.ActiveWorkbook.Saved = True
  XLS.ActiveWorkbook.Close   False
  'XLS.Application.Quit
  End Sub



' ----------------------------------------------------------------------
  Function CurrDate
' ----------------------------------------------------------------------
  'Dim T0 : T0 = Now
  CurrDate = Year(T0) & "-" & Right("0"&Month(T0),2) & "-" & Right("0"&Day(T0),2)
  End Function



' ----------------------------------------------------------------------
  Function CurrTime
' ----------------------------------------------------------------------
  'Dim T0 : T0 = Now
  CurrTime = Right("0"&Hour(T0),2) & "." & Right("0"&Minute(T0),2) & "." & Right("0"&Second(T0),2)
  End Function



' Play selected sound to indicate 'finish successfully'
' ----------------------------------------------------------------------
  Sub Ding
' ----------------------------------------------------------------------
  Const wavFile = "C:\Windows\media\Windows Background.wav"
  Dim oVoice        : Set oVoice        = CreateObject("SAPI.SpVoice")
  Dim oSpFileStream : Set oSpFileStream = CreateObject("SAPI.SpFileStream")
  oSpFileStream.Open wavFile
  oVoice.SpeakStream oSpFileStream
  oSpFileStream.Close
  End Sub

Works well. Just a bit slow - creating the "Word.Basic" somehow causes cca 5 seconds delay. Not sure why. After that, Excel works fine.

For example, you can make it run on hotkey like Ctrl+F12 or something similar (via creating shortcut), and then, will work anywhere.