SendKeystr



Option Explicit

'local variable(s) to hold property value(s)

Private mvarDestination As Long 'local copy
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SHIFT = &H10

Private Declare Function OemKeyScan Lib "user32" _
(ByVal wOemChar As Integer) As Long
Private Declare Function CharToOem Lib "user32" _
Alias "CharToOemA" (ByVal lpszSrc As String, _
ByVal lpszDst As String) As Long
Private Declare Function VkKeyScan Lib "user32" _
Alias "VkKeyScanA" (ByVal cChar As Byte) As Integer
Private Declare Function MapVirtualKey Lib "user32" _
Alias "MapVirtualKeyA" (ByVal wCode As Long, _
ByVal wMapType As Long) As Long
Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Sub SendAKey(ByVal keys As String)
Dim vk%
Dim shiftscan%
Dim scan%
Dim oemchar$
Dim dl&
Dim shiftkey%
'Get the virtual key code for this character

vk% = VkKeyScan(Asc(keys)) And &HFF
'See if shift key needs to be pressed

shiftkey% = VkKeyScan(Asc(keys)) And 256
oemchar$ = " " ' 2 character buffer
'Get the OEM character - preinitialize the buffer

CharToOem Left$(keys, 1), oemchar$
'Get the scan code for this key

scan% = OemKeyScan(Asc(oemchar$)) And &HFF
'Send the key down

If shiftkey% = 256 Then
'if shift key needs to be pressed

shiftscan% = MapVirtualKey(VK_SHIFT, 0)
'press down the shift key

keybd_event VK_SHIFT, shiftscan%, 0, 0
End If

'press key to be sent

keybd_event vk%, scan%, 0, 0
'Send the key up


If shiftkey% = 256 Then
'keyup for shift key

keybd_event VK_SHIFT, shiftscan%, KEYEVENTF_KEYUP, 0
End If

'keyup for key sent

keybd_event vk%, scan%, KEYEVENTF_KEYUP, 0
End Sub

Public Sub SendKeys(ByVal keys As String)
Dim x&, t As Integer
'loop thru string to send one key at a time

For x& = 1 To Len(keys)
'activate target application

AppActivate (mvarDestination)
'send one key to target

SendAKey Mid$(keys, x&, 1)
Next x&
End Sub

Public Property Let Destination(ByVal vData As Long)
'used when assigning a value to the property,

'on the left side ofan assignment.

'Syntax: X.Destination = 5

mvarDestination = vData
End Property

Public Property Get Destination() As Long
'used when retrieving value of a property,

'on the right side of an assignment.

'Syntax: Debug.Print X.Destination

Destination = mvarDestination
End Property

(sendkeystr.html)- by Paolo Puglisi - Modifica del 25/3/2019