none
Application send-keys highlighted in bold below does not work after shell screenshot code RRS feed

  • Question


  • 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    'DO NOT MODIFY
    Private Declare PtrSafe Sub ShowWindow Lib "user32" _
        (ByVal hWnd As Long, ByVal nCmdShow As Long)
    Public Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
      bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
     Declare PtrSafe Function apiShowWindow Lib "user32" Alias "ShowWindow" _
                (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

    Global Const SW_MAXIMIZE = 3
    Global Const SW_SHOWNORMAL = 1
    Global Const SW_SHOWMINIMIZED = 2
    'Declare Virtual Key Codes
    Private Const VK_SNAPSHOT = &H2C
    Private Const VK_KEYUP = &H2
    Private Const VK_MENU = &H12
    Public Const VK_TAB = &H9
    Public Const VK_ENTER = &HD
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

    Sub Automate_FAZAL_Enter_Data()

    'Variables add/modify as required
        Dim URL As String
        Dim IE As Object
        Dim HWNDSrc As Long
        Dim LastRow, i, j As Integer
        Dim P As Range
        Dim S As Range
        Dim T As String
        Dim Default

     
     Set sht = ThisWorkbook.Worksheets("Sheet3")
     LastRow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
     
        
        Set sht_ELMTS = ThisWorkbook.Worksheets("Elements")
        
     'Loop start
     
     For j = 3 To LastRow
     
     'ooooooooooooooooo
     Set oWShell = CreateObject("wscript.shell")
      If wsh.arguments.Count <> 0 Then
        Do Until oWShell.AppActivate("Confirmation dialog title")
          wsh.sleep 50
        Loop
        oWShell.SendKeys "{enter}"
        wsh.Quit
      End If
      sCmd = "wscript.exe " & Chr(34) & wsh.scriptfullname & Chr(34) & " reenter"
     'ooooooooooooooooo
        'Create InternetExplorer Object
        Set IE = CreateObject("InternetExplorer.Application")
        '
        Set P = sht.Cells(j, 8)
        Set N = sht.Cells(j, 9)
        Set S = sht.Cells(j, 32)
        
        MsgBox "Loop Start for " & N
        'Set IE.Visible = True to make IE visible, or False for IE to run in the background
        IE.Visible = True
     
        'Define URL

        URL = "http://www.seleniumeasy.com/test/javascript-alert-box-demo.html"

        apiShowWindow IE.hWnd, SW_MAXIMIZE
        'Navigate to URL
        IE.Navigate URL
        
        ' Statusbar tells website is loading
        Application.StatusBar = URL & " is loading. Please wait..."
     
        ' Wait while IE loading...
        
        Do While IE.ReadyState = 4: DoEvents: Loop
        Do Until IE.ReadyState = 4: DoEvents: Loop
     
        'Webpage Loaded
        Application.StatusBar = URL & " Loaded"
        
      
        HWNDSrc = IE.hWnd
    '
        SetForegroundWindow HWNDSrc
    '
    'some data will be entered

    '=====================================================
    'Section 1 second snapshot
    Call keybd_event(VK_SNAPSHOT, 0, 0, 0)


          Set WSH_OBJ = CreateObject("WScript.Shell")
          WSH_OBJ.Run "mspaint"

          Application.Wait (Now + TimeValue("00:00:03"))
          WSH_OBJ.AppActivate "untitled - Paint"

          Application.Wait (Now + TimeValue("00:00:03"))
          Application.Wait (Now + TimeValue("00:00:03"))
          'Application.SendKeys ("%{TAB}")
          WSH_OBJ.SendKeys "^v"

          Application.Wait (Now + TimeValue("00:00:03"))
          Application.Wait (Now + TimeValue("00:00:04"))
          WSH_OBJ.SendKeys "^s"

          Application.Wait (Now + TimeValue("00:00:03"))
          Application.Wait (Now + TimeValue("00:00:04"))
          WSH_OBJ.SendKeys "C:\Sayantan\Enrollment-" & P & "-" & Replace(Replace(Replace(Now(), "/", "-"), " ", ""), ":", "") & "_" & N & "_Section1_BOTTOM_" & ".jpg"

          Application.Wait (Now + TimeValue("00:00:03"))
          WSH_OBJ.SendKeys "{ENTER}"

          Application.Wait (Now + TimeValue("00:00:03"))
          Application.Wait (Now + TimeValue("00:00:02"))
          WSH_OBJ.SendKeys "%f"

          Application.Wait (Now + TimeValue("00:00:03"))
          Application.Wait (Now + TimeValue("00:00:02"))
          WSH_OBJ.SendKeys "x"

          Set WSH_OBJ = Nothing
          Application.Wait (Now + TimeValue("00:00:03"))

          Application.Wait (Now + TimeValue("00:00:02"))
    '========================================================================================================================

         
          Application.Wait (Now + TimeValue("00:00:02"))
          Dim e
          Set e = IE.Document.GetElementsByClassName("btn btn-default btn-lg")(0)
          e.Click 'Confirmation box will appear
          Application.Wait (Now + TimeValue("00:00:05"))
          Application.SendKeys "{ENTER}" 'this send key does not work


                IE.Quit

    MsgBox "End"

    Next j

    '=============================================================================================================================================
        'Unload IE
        Set IE = Nothing
        
        
    End Sub

    • Moved by Bill_Stewart Friday, July 27, 2018 7:47 PM This is not "debug/fix/rewrite my script for me" forum
    Thursday, May 10, 2018 11:06 AM

All replies

  • This is not a VB forum.  Please post VB6 questions in a VB6 forum.

    "SendKeys" will not work correctly on any current version of Windows.  It is an old W98 and earlier command that was kept for compatibility.


    \_(ツ)_/

    Thursday, May 10, 2018 1:19 PM