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 Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Const WM_CLOSE As Long = &H10
Private Const WM_QUIT As Long = &H12
Private Const VK_SNAPSHOT As Byte = 44
Private Const VK_LCONTROL As Long = &HA2
Private Const VK_V = &H56
Private Const VK_F = &H46
Private Const VK_S = &H53
Private Const VK_MENU = &H12
Private Const KEYEVENTF_KEYUP = &H2
Private Const BM_CLICK As Long = &HF5
Private Const WM_SETTEXT As Long = &HC
Private Sub Command1_Click()
Dim strFilePathName As String
Dim lHwnd As Long
Dim lHwndC As Long
Dim lHwndC1 As Long
Dim lHwndC2 As Long
Dim dDelay As Date
Dim sFileName As String
Clipboard.Clear
DoEvents
Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
DoEvents
'PATH DEPENDS UPON OS (WIN2K AND BELOW - XP = C:\Windows\System32\mspaint.exe)
strFilePathName = "C:\Winnt\System32\mspaint.exe"
Shell strFilePathName, vbNormalFocus
lHwnd = 0
lHwndC = 0
'WAIT FOR PAINT TO STARTUP
Do Until lHwnd <> 0
DoEvents
lHwnd = FindWindow("MSPaintApp", "untitled - Paint")
Loop
keybd_event VK_LCONTROL, 0, 0, 0 'PRESS CTL
keybd_event VK_V, 0, 0, 0 'PRESS V
keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0 'RELEASE V
keybd_event VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0 'RELEASE CTL
'WAIT FOR PROMPT TO ASK TO ENLARGE CANVAS (WIN2K AND BELOW ONLY)
lHwnd = 0
lHwndC = 0
Do Until lHwnd <> 0
DoEvents
lHwnd = FindWindow("#32770", "Paint")
Loop
lHwndC = FindWindowEx(lHwnd, 0&, "BUTTON", "&Yes")
SendMessage lHwndC, BM_CLICK, 0&, 0&
'WAIT FOR MESSAGEBOX TO CLOSE
Do Until lHwnd = 0
DoEvents
lHwnd = FindWindow("#32770", "Paint")
Loop
'/WAIT FOR PROMPT TO ASK TO ENLARGE CANVAS (WIN2K AND BELOW ONLY)
'SAVE FILE
keybd_event VK_MENU, 0, 0, 0 'PRESS ATL
keybd_event VK_F, 0, 0, 0 'PRESS F
keybd_event VK_F, 0, KEYEVENTF_KEYUP, 0 'RELEASE V
keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0 'RELEASE ATL
keybd_event VK_S, 0, 0, 0 'PRESS S
keybd_event VK_S, 0, KEYEVENTF_KEYUP, 0 'RELEASE S
'ENTER FILENAME TO SAVE AS
lHwnd = 0
lHwndC = 0
Do Until lHwnd <> 0
DoEvents
lHwnd = FindWindow("#32770", "Save As")
Loop
lHwndC = FindWindowEx(lHwnd, 0&, "COMBOBOXEX32", vbNullString)
Do Until lHwndC <> 0
lHwndC = FindWindowEx(lHwnd, 0&, "COMBOBOXEX32", vbNullString)
Loop
lHwndC1 = FindWindowEx(lHwndC, 0&, "COMBOBOX", vbNullString)
Do Until lHwndC1 <> 0
lHwndC1 = FindWindowEx(lHwndC, 0&, "COMBOBOX", vbNullString)
Loop
lHwndC2 = FindWindowEx(lHwndC1, 0&, "EDIT", vbNullString)
Do Until lHwndC2 <> 0
lHwndC2 = FindWindowEx(lHwndC1, 0&, "EDIT", vbNullString)
Loop
'FORMAT A UNIQUE FILENAME TO AVOID THE OVERWRITE PROMPT MESSAGE
sFileName = "Screenshot_" & Format(Now, "MM-DD-YYYY_HH-MM-SS_AMPM") & ".bmp"
'ONE SECOND DELAY TO ALLOW PROCESSING
dDelay = Now
Do While DateDiff("s", dDelay, Now) < 1
DoEvents
Loop
'ENTER THE FILENAME TEXT INTO THE COMBO BOX
SendMessage lHwndC, WM_SETTEXT, 0&, ByVal sFileName
'ONE SECOND DELAY TO ALLOW SENDMESSAGE PROCESSING
dDelay = Now
Do While DateDiff("s", dDelay, Now) < 1
DoEvents
Loop
lHwndC = FindWindowEx(lHwnd, 0&, "BUTTON", "&Save")
'CLICK THE SAVE BUTTON
SendMessage lHwndC, BM_CLICK, 0&, 0&
'ONE SECOND DELAY TO ALLOW SENDMESSAGE PROCESSING
dDelay = Now
Do While DateDiff("s", dDelay, Now) < 1
DoEvents
Loop
'WAIT FOR PAINT TO SAVE AND GET NEW HANDEL
lHwnd = 0
Do Until lHwnd <> 0
DoEvents
lHwnd = FindWindow("MSPaintApp", sFileName & " - Paint")
Loop
'QUIT PAINT
PostMessage lHwnd, WM_QUIT, 0&, 0&
End Sub
