title: Snipping Tool does not start a snip while running Excel Macro?
body: <p>I want to automatically snip an area of the screen. I'm using these libraries and definitions:</p>
  
  <pre><code>'------ I don't own these functions. Copied them from the Internet. ------
  Public Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
  Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
  Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
  Public Const MOUSEEVENTF_LEFTDOWN = &amp;H2
  Public Const MOUSEEVENTF_LEFTUP = &amp;H4
  'The following two functions are for retrieving the color under mouse pointer
  Public Declare Function GetWindowDC Lib "User32" (ByVal hwnd As Long) As Long
  Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  
  Public Function IsExeRunning(sExeName As String, Optional sComputer As String = ".") As Boolean
  On Error GoTo Error_Handler
  Dim objProcesses    As Object
  
  Set objProcesses = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &amp; sComputer &amp; "\root\cimv2").ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" &amp; sExeName &amp; "'")
  If objProcesses.Count &lt;&gt; 0 Then IsExeRunning = True
  
  Error_Handler_Exit:
  On Error Resume Next
  Set objProcesses = Nothing
  Exit Function
  
  Error_Handler:
  MsgBox "The following error has occured." &amp; vbCrLf &amp; vbCrLf &amp; _
          "Error Number: IsExeRunning" &amp; vbCrLf &amp; _
          "Error Description: " &amp; Err.Description, _
          vbCritical, "An Error has Occured!"
  Resume Error_Handler_Exit
  End Function
  </code></pre>
  
  <p>I first have a calibration macro to set up where the mouse should start (see image for reference) <a href="https://i.stack.imgur.com/MwHZB.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/MwHZB.png" alt="Artcam Example"></a></p>
  
  <pre><code>'Calibrate mouse positions for GetColor sub below
  'I realize I could just use two corner points, but I didn't think of that until after this was used.
  Sub CalibrateColorPositions()
  
  MsgBox "Please hover over the top center of the ArtCam work area (just under the top ruler) and press Enter.", vbOKOnly
  GetCursorPos pos
  SaveSetting "Will's Program Sheet", "CP Calibration", "Top Y", pos.y
  SaveSetting "Will's Program Sheet", "CP Calibration", "Top X", pos.x
  
  MsgBox "Please hover over the right center of the ArtCam work area (just left of the scrollbar) and press Enter.", vbOKOnly
  GetCursorPos pos
  SaveSetting "Will's Program Sheet", "CP Calibration", "Right Y", pos.y
  SaveSetting "Will's Program Sheet", "CP Calibration", "Right X", pos.x
  
  MsgBox "Please hover over the bottom center of the ArtCam work area (just above the scrollbar) and press Enter.", vbOKOnly
  GetCursorPos pos
  SaveSetting "Will's Program Sheet", "CP Calibration", "Bottom Y", pos.y
  SaveSetting "Will's Program Sheet", "CP Calibration", "Bottom X", pos.x
  
  MsgBox "Please hover over the left center of the ArtCam work area (just right of the ruler) and press Enter.", vbOKOnly
  GetCursorPos pos
  SaveSetting "Will's Program Sheet", "CP Calibration", "Left Y", pos.y
  SaveSetting "Will's Program Sheet", "CP Calibration", "Left X", pos.x
  
  MsgBox "Thanks! Calibration finished!", vbOKOnly
  End Sub
  </code></pre>
  
  <p>I then have this in a Sub (I believe the problem occurs at the very end):</p>
  
  <pre><code>Sub GetColor()
  Dim sTmp As String
  Dim lColor As Long
  Dim lDC As Long
  Dim vSide As Integer
  Dim TranslateX As Double, TranslateY As Double
  Dim CurrentPosX As Long, CurrentPosY As Long
  Dim TopX As Long, TopY As Long, RightX As Long, RightY As Long, BottomX As Long, BottomY As Long, LeftX As Long, LeftY As Long
  Dim FinalTop As Long, FinalRight As Long, FinalBottom As Long, FinalLeft As Long
  
  Dim wsh As Object
  Set wsh = VBA.CreateObject("WScript.Shell")
  Dim waitOnReturn As Boolean: waitOnReturn = False
  Dim windowStyle As Integer: windowStyle = 1
  
  TopX = GetSetting("Will's Program Sheet", "CP Calibration", "Top X", 0)
  If TopX = 0 Then
  CalibrateColorPositions 'Set calibration coordinates and exit sub
  Exit Sub
  End If
  
  'Retrieve calibrated coordinates and set them to variables
  TopY = GetSetting("Will's Program Sheet", "CP Calibration", "Top Y", 0)
  RightX = GetSetting("Will's Program Sheet", "CP Calibration", "Right X", 0)
  RightY = GetSetting("Will's Program Sheet", "CP Calibration", "Right Y", 0)
  BottomX = GetSetting("Will's Program Sheet", "CP Calibration", "Bottom X", 0)
  BottomY = GetSetting("Will's Program Sheet", "CP Calibration", "Bottom Y", 0)
  LeftX = GetSetting("Will's Program Sheet", "CP Calibration", "Left X", 0)
  LeftY = GetSetting("Will's Program Sheet", "CP Calibration", "Left Y", 0)
  
  sTmp = "535353" 'Our ArtCam programs have a gray background
  
  'Run four times (Top, Right, Bottom, and Left)
  For vSide = 1 To 4
  Select Case vSide
  Case 1
  'Move mouse to position
  CurrentPosX = TopX
  CurrentPosY = TopY
  'Which direction should the mouse move?
  TranslateX = 0
  TranslateY = 10
  Case 2
  CurrentPosX = RightX
  CurrentPosY = RightY
  TranslateX = -10
  TranslateY = 0
  sTmp = "535353"
  Case 3
  CurrentPosX = BottomX
  CurrentPosY = BottomY
  TranslateX = 0
  TranslateY = -10
  sTmp = "535353"
  Case 4
  CurrentPosX = LeftX
  CurrentPosY = LeftY
  TranslateX = 10
  TranslateY = 0
  sTmp = "535353"
  End Select
  
  While sTmp = "535353" 'If color under mouse is still gray, translate mouse.
  
  CurrentPosX = CurrentPosX + TranslateX
  CurrentPosY = CurrentPosY + TranslateY
  SetCursorPos CurrentPosX, CurrentPosY
  
  lDC = GetWindowDC(0)
  GetCursorPos pos
  lColor = GetPixel(lDC, pos.x, pos.y)
  
  sTmp = Right$("000000" &amp; Hex(lColor), 6)
  Debug.Print ("R:" &amp; Right$(sTmp, 2) &amp; " G:" &amp; _
       Mid$(sTmp, 3, 2) &amp; " B:" &amp; Left$(sTmp, 2))
  Wend
  'Once it has detected a different color, save that position for later.
  Select Case vSide
  Case 1
  FinalTop = CurrentPosY
  Case 2
  FinalRight = CurrentPosX
  Case 3
  FinalBottom = CurrentPosY
  Case 4
  FinalLeft = CurrentPosX
  End Select
  Next
  'Start Snipping Tool (and automatically start snip if necessary)
  Application.CutCopyMode = False
  wsh.Run "C:\Windows\sysnative\SnippingTool.exe"
  x = 0
  Select Case Mid(Application.OperatingSystem, 21)
  Case 6.02
  Do Until IsExeRunning("SnippingTool.exe") = True Or x = 500
  x = x + 1
  Loop
  Sleep (350)
  '--------PROBLEM IS ASSUMED HERE-------
  AppActivate "Snipping Tool", True
  Application.SendKeys "^N", True
  End Select
  
  SetCursorPos FinalLeft - 10, FinalTop - 10
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  SetCursorPos FinalRight + 10, FinalBottom + 10
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
  End Sub
  </code></pre>
  
  <p>The Snipping Tool overlay never shows up and the mouse just selects everything between the coordinates. The overlay appears if the mouse events aren't there, but I NEED the mouse events to make this work!</p>
  
  <p>EDIT: I've made <em>some</em> headway. I was able to get it to snip, <strong>but</strong> it's extremely unreliable. I use SetCursorPos to click the New on Snipping Tool manually and works. Perhaps someone can figure out a more reliable method or provide some tips? Changed code below:</p>
  
  <pre><code>'--------PROBLEM IS ASSUMED HERE-------
  'AppActivate "Snipping Tool", True
  'testageNew
  End Select
  
  snipposition 'Manually click New (Sub below)
  
  Sleep (500) 'Add some delay for it to start.
  
  'Click and hold the top left to the bottom right position (AKA, take snip)
  SetCursorPos FinalLeft - 10, FinalTop - 10
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  SetCursorPos FinalRight + 10, FinalBottom + 10
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
  End Sub
  
  Sub snipposition()
  'Made separate Sub for user to test coordinates without running whole Sub.
  SetCursorPos 850, 250 'Coordinates of Snipping Tool New button.
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 'Click it.
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
  End Sub
  </code></pre>