Vbscript Imprimir pantalla a MSpaint

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.

preguntado el 05 de mayo de 13 a las 12:05

2 Respuestas

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.

contestado el 05 de mayo de 13 a las 12:05

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.

respondido 08 nov., 19:08

No es la respuesta que estás buscando? Examinar otras preguntas etiquetadas or haz tu propia pregunta.