My user will open the desired Web Page(www.TD-Digital.com) for testing purposes
My user will then "Restore" my App which is running minimized in the task bar, then Click a button in my app that will send keys to the open Web page.
I have tried two different methods to accomplish this and neither works.
The first Scripting method, crashes with an error 424 on the "Set MyShell = WScript.CreateObject("WScript.Shell")
" line.
The second method runs but the keys do not appear in the Web page.
What am I doing wrong on both cases?
My user will then "Restore" my App which is running minimized in the task bar, then Click a button in my app that will send keys to the open Web page.
I have tried two different methods to accomplish this and neither works.
The first Scripting method, crashes with an error 424 on the "Set MyShell = WScript.CreateObject("WScript.Shell")
" line.
The second method runs but the keys do not appear in the Web page.
What am I doing wrong on both cases?
Code:
Const KEYEVENTF_KEYDOWN As Long = 0
Const KEYEVENTF_KEYUP As Long = 2
Const VK_SHIFT As Long = 16
Const VK_TAB = &H9
Private Response, WinTitle As String, WinClass As String, WinHwnd As Long
Private ReturnValue, nVK As Long
'****
Private Declare Function VkKeyScan Lib "user32" Alias "VkKeyScanA" (ByVal _
cChar As Byte) As Integer
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" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
'***************************************
Private Sub Form_Load()
Left = (Screen.Width - Width) / 2
Top = ((Screen.Height - Height) / 2)
End Sub
'***********************************************
Private Sub cmdTransfer_Click()
Dim MyShell
Me.Hide
Set MyShell = WScript.CreateObject("WScript.Shell")
MyShell.AppActivate "Richmond Times Dispatch - Windows Internet Explorer provided by CenturyLink"
MyShell.SendKeys "Tom", wait
MyShell.SendKeys "{Tab}", wait
MyShell.SendKeys "Smith", wait
GoTo ExitProc
WinHwnd = FindWindow(vbNullString, "Richmond Times Dispatch - Windows internet Explorer provided by CenturyLink")
If WinHwnd > 0 Then
'AppActivate WinTitle
ReturnValue = SetActiveWindow(WinHwnd)
Else
MsgBox "Window not found - Reenter"
GoTo ExitProc
End If
sName = "Smith"
Call SendAKey(sName)
keybd_event VK_TAB, 0, KEYEVENTF_KEYDOWN, 0
keybd_event VK_TAB, 0, KEYEVENTF_KEYUP, 0
sName = "Man"
Call SendAKey(sName)
ExitProc:
ReturnValue = Shell("C:\Program Files\DeiTransferData\DeiTransferData.exe", 0)
End
End Sub
'*********************************************
Private Sub SendAKey(name)
Dim Start As Integer, NameLen As Integer, sKey As String
Start = 1
NameLen = Len(name)
If NameLen > 0 Then
Do While Start <= NameLen
sKey = Mid(name, Start, 1)
nVK = VkKeyScan(Asc(sKey)) And &HFF
' Capitalize all letters
If sKey Like "[a-z]" Or sKey Like "[A-Z]" Then
keybd_event VK_SHIFT, 0, KEYEVENTF_KEYDOWN, 0
keybd_event nVK, 0, KEYEVENTF_KEYDOWN, 0
keybd_event VK_SHIFT, 0, KEYEVENTF_KEYUP, 0
' DON'T Capitalize these
ElseIf sKey = "," Or sKey = "." Or sKey = "'" Or sKey = "-" _
Or sKey Like "[1-9]" Then
keybd_event nVK, 0, KEYEVENTF_KEYDOWN, 0
' Capitalize Shift Number Keys
ElseIf UCase(sKey) = sKey Then
keybd_event VK_SHIFT, 0, KEYEVENTF_KEYDOWN, 0
keybd_event nVK, 0, KEYEVENTF_KEYDOWN, 0
keybd_event VK_SHIFT, 0, KEYEVENTF_KEYUP, 0
Else
keybd_event nVK, 0, KEYEVENTF_KEYDOWN, 0
End If
keybd_event nVK, 0, KEYEVENTF_KEYUP, 0
Start = Start + 1
Loop
Else
MsgBox "Enter some Valid input", vbExclamation
End If
End Sub