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 GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Const CF_BITMAP = 2
Private Type PicBmp
Size As Long
type As Long
hBmp As Long
hpal As Long
Reserved As Long
End Type
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Sub My_Screen_1()
Call keybd_event(vbKeySnapshot, 0, 0, 0)
DoEvents
End Sub
Private Sub My_Screen_2()
Call keybd_event(vbKeySnapshot, 1, 1, 1)
DoEvents
End Sub
Sub Scheduled_Snapshot()
Dim Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID
Call My_Screen_2
oTime = Now()
OpenClipboard 0
With Pic
.Size = Len(Pic)
.type = 1
.hBmp = GetClipboardData(CF_BITMAP)
End With
OleCreatePictureIndirect Pic, IID_IDispatch, 1, IPic
stdole.SavePicture IPic, "d:\snapshot_" & Format(Now(), "yyyy-mm-dd hhnnss") & ".bmp"
CloseClipboard
End Sub