Results 1 to 13 of 13

Thread: VB6 - Automaticall save screenshot to MS Paint and save with a timestamp filename

  1. #1

    Thread Starter
    Ex-Super Mod RobDog888's Avatar
    Join Date
    Apr 2001
    Location
    LA, Calif. Raiders #1 AKA:Gangsta Yoda™
    Posts
    60,710

    VB6 - Automaticall save screenshot to MS Paint and save with a timestamp filename

    Here is how to perform a screenshot and save it to Paint automatically
    with a timestamp file name. I dont know if anyone find this useful,
    but it shows the mechanics of automating a program on the same
    calling thread.

    VB Code:
    1. Option Explicit
    2.  
    3. Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, _
    4. ByVal dwExtraInfo As Long)
    5.  
    6. Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, _
    7. ByVal lpWindowName As String) As Long
    8.  
    9. Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
    10. ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    11.  
    12. Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
    13. ByVal wParam As Long, ByVal lParam As Long) As Long
    14.  
    15. Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
    16. ByVal wParam As Long, lParam As Any) As Long
    17.  
    18. Private Const WM_CLOSE As Long = &H10
    19. Private Const WM_QUIT As Long = &H12
    20.  
    21. Private Const VK_SNAPSHOT As Byte = 44
    22. Private Const VK_LCONTROL As Long = &HA2
    23. Private Const VK_V = &H56
    24. Private Const VK_F = &H46
    25. Private Const VK_S = &H53
    26. Private Const VK_MENU = &H12
    27. Private Const KEYEVENTF_KEYUP = &H2
    28. Private Const BM_CLICK As Long = &HF5
    29. Private Const WM_SETTEXT As Long = &HC
    30.  
    31. Private Sub Command1_Click()
    32.  
    33.     Dim strFilePathName As String
    34.     Dim lHwnd As Long
    35.     Dim lHwndC As Long
    36.     Dim lHwndC1 As Long
    37.     Dim lHwndC2 As Long
    38.     Dim dDelay As Date
    39.     Dim sFileName As String
    40.    
    41.     Clipboard.Clear
    42.     DoEvents
    43.     Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
    44.     DoEvents
    45.     'PATH DEPENDS UPON OS (WIN2K AND BELOW - XP = C:\Windows\System32\mspaint.exe)
    46.     strFilePathName = "C:\Winnt\System32\mspaint.exe"
    47.     Shell strFilePathName, vbNormalFocus
    48.     lHwnd = 0
    49.     lHwndC = 0
    50.     'WAIT FOR PAINT TO STARTUP
    51.     Do Until lHwnd <> 0
    52.         DoEvents
    53.         lHwnd = FindWindow("MSPaintApp", "untitled - Paint")
    54.     Loop
    55.     keybd_event VK_LCONTROL, 0, 0, 0  'PRESS CTL
    56.     keybd_event VK_V, 0, 0, 0  'PRESS V
    57.     keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0  'RELEASE V
    58.     keybd_event VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0  'RELEASE CTL
    59.    
    60.     'WAIT FOR PROMPT TO ASK TO ENLARGE CANVAS (WIN2K AND BELOW ONLY)
    61.     lHwnd = 0
    62.     lHwndC = 0
    63.     Do Until lHwnd <> 0
    64.         DoEvents
    65.         lHwnd = FindWindow("#32770", "Paint")
    66.     Loop
    67.     lHwndC = FindWindowEx(lHwnd, 0&, "BUTTON", "&Yes")
    68.     SendMessage lHwndC, BM_CLICK, 0&, 0&
    69.     'WAIT FOR MESSAGEBOX TO CLOSE
    70.     Do Until lHwnd = 0
    71.         DoEvents
    72.         lHwnd = FindWindow("#32770", "Paint")
    73.     Loop
    74.     '/WAIT FOR PROMPT TO ASK TO ENLARGE CANVAS (WIN2K AND BELOW ONLY)
    75.    
    76.     'SAVE FILE
    77.     keybd_event VK_MENU, 0, 0, 0  'PRESS ATL
    78.     keybd_event VK_F, 0, 0, 0  'PRESS F
    79.     keybd_event VK_F, 0, KEYEVENTF_KEYUP, 0  'RELEASE V
    80.     keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0  'RELEASE ATL
    81.     keybd_event VK_S, 0, 0, 0  'PRESS S
    82.     keybd_event VK_S, 0, KEYEVENTF_KEYUP, 0  'RELEASE S
    83.     'ENTER FILENAME TO SAVE AS
    84.     lHwnd = 0
    85.     lHwndC = 0
    86.     Do Until lHwnd <> 0
    87.         DoEvents
    88.         lHwnd = FindWindow("#32770", "Save As")
    89.     Loop
    90.     lHwndC = FindWindowEx(lHwnd, 0&, "COMBOBOXEX32", vbNullString)
    91.     Do Until lHwndC <> 0
    92.         lHwndC = FindWindowEx(lHwnd, 0&, "COMBOBOXEX32", vbNullString)
    93.     Loop
    94.     lHwndC1 = FindWindowEx(lHwndC, 0&, "COMBOBOX", vbNullString)
    95.     Do Until lHwndC1 <> 0
    96.         lHwndC1 = FindWindowEx(lHwndC, 0&, "COMBOBOX", vbNullString)
    97.     Loop
    98.     lHwndC2 = FindWindowEx(lHwndC1, 0&, "EDIT", vbNullString)
    99.     Do Until lHwndC2 <> 0
    100.         lHwndC2 = FindWindowEx(lHwndC1, 0&, "EDIT", vbNullString)
    101.     Loop
    102.     'FORMAT A UNIQUE FILENAME TO AVOID THE OVERWRITE PROMPT MESSAGE
    103.     sFileName = "Screenshot_" & Format(Now, "MM-DD-YYYY_HH-MM-SS_AMPM") & ".bmp"
    104.     'ONE SECOND DELAY TO ALLOW PROCESSING
    105.     dDelay = Now
    106.     Do While DateDiff("s", dDelay, Now) < 1
    107.         DoEvents
    108.     Loop
    109.     'ENTER THE FILENAME TEXT INTO THE COMBO BOX
    110.     SendMessage lHwndC, WM_SETTEXT, 0&, ByVal sFileName
    111.     'ONE SECOND DELAY TO ALLOW SENDMESSAGE PROCESSING
    112.     dDelay = Now
    113.     Do While DateDiff("s", dDelay, Now) < 1
    114.         DoEvents
    115.     Loop
    116.     lHwndC = FindWindowEx(lHwnd, 0&, "BUTTON", "&Save")
    117.     'CLICK THE SAVE BUTTON
    118.     SendMessage lHwndC, BM_CLICK, 0&, 0&
    119.     'ONE SECOND DELAY TO ALLOW SENDMESSAGE PROCESSING
    120.     dDelay = Now
    121.     Do While DateDiff("s", dDelay, Now) < 1
    122.         DoEvents
    123.     Loop
    124.     'WAIT FOR PAINT TO SAVE AND GET NEW HANDEL
    125.     lHwnd = 0
    126.     Do Until lHwnd <> 0
    127.         DoEvents
    128.         lHwnd = FindWindow("MSPaintApp", sFileName & " - Paint")
    129.     Loop
    130.     'QUIT PAINT
    131.     PostMessage lHwnd, WM_QUIT, 0&, 0&
    132.    
    133. End Sub
    VB/Outlook Guru
    VB/Office Guru™ (AKA: Gangsta Yoda®)
    I dont answer coding questions via PM. Please post a thread in the appropriate forum.

    Microsoft MVP 2006-2011
    Office Development FAQ (C#, VB.NET, VB 6, VBA)
    Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
    If a post has helped you then Please Rate it!
    Reps & Rating PostsVS.NET on Vista Multiple .NET Framework Versions Office Primary Interop AssembliesVB/Office Guru™ Word SpellChecker™.NETVB/Office Guru™ Word SpellChecker™ VB6VB.NET Attributes Ex.Outlook Global Address ListAPI Viewer utility.NET API Viewer Utility
    System: Intel i7 6850K, Geforce GTX1060, Samsung M.2 1 TB & SATA 500 GB, 32 GBs DDR4 3300 Quad Channel RAM, 2 Viewsonic 24" LCDs, Windows 10, Office 2016, VS 2019, VB6 SP6

  2. #2
    New Member
    Join Date
    Jan 2007
    Posts
    2

    Re: VB6 - Automaticall save screenshot to MS Paint and save with a timestamp filename

    This code is brilliant - thanks for sharing.

    I wanted to ask, I need to take this code one step further. I need to save the .bmp as a .jpg. I can make the extension in the file name as NAME.jpg, but the file type stays as bitmap.

    Do you know how to change the combo box file type to jpg? (I need to change the file type to jpg to save space).

    Thanks in advance.

  3. #3
    "Digital Revolution"
    Join Date
    Mar 2005
    Posts
    4,471

    Re: VB6 - Automaticall save screenshot to MS Paint and save with a timestamp filename

    Quote Originally Posted by janineweyers
    This code is brilliant - thanks for sharing.

    I wanted to ask, I need to take this code one step further. I need to save the .bmp as a .jpg. I can make the extension in the file name as NAME.jpg, but the file type stays as bitmap.

    Do you know how to change the combo box file type to jpg? (I need to change the file type to jpg to save space).

    Thanks in advance.
    VB doesn't directly support saving to JPEG.

    But you can use this code here so you don't have to use a 3rd party OCX/DLL file.

    http://www.pscode.com/vb/scripts/Sho...50065&lngWId=1

  4. #4
    New Member
    Join Date
    Jan 2007
    Posts
    2

    Re: VB6 - Automaticall save screenshot to MS Paint and save with a timestamp filename

    Thanks DigiRev, that's exactly what I was after. I had spent days trying to do this and also researching this - I am very grateful.

  5. #5
    Junior Member
    Join Date
    Dec 2006
    Posts
    20

    Re: VB6 - Automaticall save screenshot to MS Paint and save with a timestamp filename

    HI everybody.
    First of all thank's to RobDog888 for this cool code.
    It's very useful also because it explains tips about FindWindowEX and so on...

    I run the project but it doesn't work .
    Is it my fault ? When i run program, paint starts, then nothing to do...
    I would like use this program. May you help me ?

    Thank's

  6. #6
    Junior Member
    Join Date
    Dec 2006
    Posts
    20

    Re: VB6 - Automaticall save screenshot to MS Paint and save with a timestamp filename

    Ok,
    It works fine !!!
    It was my fault.

  7. #7
    New Member
    Join Date
    Feb 2009
    Posts
    1

    Re: VB6 - Automaticall save screenshot to MS Paint and save with a timestamp filename

    How can i copy the code? It isn't copied correctly, all on one line

  8. #8
    VB For Fun Edgemeal's Avatar
    Join Date
    Sep 2006
    Location
    WindowFromPoint
    Posts
    4,255

    Re: VB6 - Automaticall save screenshot to MS Paint and save with a timestamp filename

    Quote Originally Posted by roberini
    How can i copy the code? It isn't copied correctly, all on one line
    One way is to click the Quote button like if you were going to reply to the post, then copy the text code from that reply window.

  9. #9
    New Member
    Join Date
    Sep 2009
    Posts
    3

    Re: VB6 - Automaticall save screenshot to MS Paint and save with a timestamp filename

    Hi guys, I made a program that does this, but when I press the command button I get an error on this line of code:

    " Shell strFilePathName, vbNormalFocus" It's the line after it's supposed to start mspaint.

    I think I may have messed up the location of my mspaint, but I'll keep trying and check back here.


    Also, would there be a way I could use a key combination, such as Shift + End, or Ctrl + F1?

    I'm also sorry for bumping an old thread, I just really want to get this to work, it's such a brilliant code.

  10. #10
    Lively Member
    Join Date
    Aug 2009
    Posts
    64

    Re: VB6 - Automaticall save screenshot to MS Paint and save with a timestamp filename

    Is there any chance to make this work on windows 7? It always stop when paint is launch and would it possible just capture active documents like what Alt + Screenshot do not the whole windows?

  11. #11
    Hyperactive Member
    Join Date
    Jun 2012
    Location
    I'm living in VBForum bcz its members deserve respect and appreciation
    Posts
    333

    Re: VB6 - Automaticall save screenshot to MS Paint and save with a timestamp filename

    Thank you Rob. For your brilliant code. I have used it all work fine except it's not change File Name in Combobox? and i have do some code to see as below:
    Code:
       
      '
      '
      '
     lHwndC = FindWindowEx(lHwnd, 0&, "COMBOBOXEX32", "")
        If (lHwndC = 0) Then
         MsgBox ("lHwndC , window not found")       ' msgbox shows as lHwndC not found
        End If
        Do Until lHwndC <> 0
            lHwndC = FindWindowEx(lHwnd, 0&, "COMBOBOXEX32", vbNullString)
        Loop
        lHwndC1 = FindWindowEx(lHwndC, 0&, "COMBOBOX", vbNullString)
      '
      '
      '
    Please Why it's File Name not updated? Please assist?

  12. #12
    Hyperactive Member
    Join Date
    Jun 2012
    Location
    I'm living in VBForum bcz its members deserve respect and appreciation
    Posts
    333

    Re: VB6 - Automaticall save screenshot to MS Paint and save with a timestamp filename

    Now i got above post to work and it's working. Thank you again gor your awesome code.
    I just wondering how to change the directory of saved image path as i point you in attached image by using vb6 code? for example i want to saved picture in directory E:\Damage. Thank you
    Attached Images Attached Images  

  13. #13
    New Member
    Join Date
    Oct 2013
    Location
    LAHORE PAKISTAN
    Posts
    3

    Re: VB6 - Automaticall save screenshot to MS Paint and save with a timestamp filename

    its Good WORKING

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width