Visual Basic Programming Code Examples

Replacement for Sendkeys using a class containing API calls The following class module code contains code which can be used as a replacement for the "SendKeys" statement. 'Place following code in a class module Option Explicit Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long Private Declare Function VkKeyScan Lib "user32" Alias "VkKeyScanA" (ByVal cChar As Byte) 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 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long Private Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Any) As Long Private Const KEYEVENTF_EXTENDEDKEY = &H1 Private Const KEYEVENTF_KEYUP = &H2 Public Enum eKeys keyBackspace = &H8 keyTab = &H9 keyReturn = &HD keyShift = &H10 keyControl = &H11 keyAlt = &H12 keyPause = &H13 keyEscape = &H1B keySpace = &H20 keyEnd = &H23 keyHome = &H24 keyLeft = &H25 KeyUp = &H26 keyRight = &H27 KeyDown = &H28 keyInsert = &H2D keyDelete = &H2E keyF1 = &H70 keyF2 = &H71 keyF3 = &H72 keyF4 = &H73 keyF5 = &H74 keyF6 = &H75 keyF7 = &H76 keyF8 = &H77 keyF9 = &H78 keyF10 = &H79 keyF11 = &H7A keyF12 = &H7B keyNumLock = &H90 keyScrollLock = &H91 keyCapsLock = &H14 End Enum Public Enum eLockKey CapsLock = keyCapsLock NumLock = keyNumLock ScrollLock = keyScrollLock End Enum Private zlKeyPressDelay As Long 'Purpose : Press a single key represented by a string 'Inputs : sKey The key to press. ' [bHoldKeydown] If True does not release the key press. ' [bRelease] If True releases a "HoldKeydown" key press (see above). 'Outputs : N/A Public Sub SendKey(sKey As String, Optional bHoldKeydown As Boolean = False, Optional bRelease As Boolean = False) Dim lScan As Long, lExtended As Long, lVK As Long Dim bShift As Boolean, bCtrl As Boolean, bAlt As Boolean lVK = VkKeyScan(Asc(sKey)) If lVK Then lScan = MapVirtualKey(lVK, 2) lExtended = 0 If lScan = 0 Then lExtended = KEYEVENTF_EXTENDEDKEY End If lScan = MapVirtualKey(lVK, 0) bShift = (lVK And &H100) bCtrl = (lVK And &H200) bAlt = (lVK And &H400) lVK = (lVK And &HFF) If bRelease = False Then If bShift Then keybd_event eKeys.keyShift, 0, 0, 0 End If If bCtrl Then keybd_event eKeys.keyControl, 0, 0, 0 End If If bAlt Then keybd_event eKeys.keyAlt, 0, 0, 0 End If keybd_event lVK, lScan, lExtended, 0 End If If bHoldKeydown = False Then keybd_event lVK, lScan, KEYEVENTF_KEYUP Or lExtended, 0 If bShift Then keybd_event eKeys.keyShift, 0, KEYEVENTF_KEYUP, 0 End If If bCtrl Then keybd_event eKeys.keyControl, 0, KEYEVENTF_KEYUP, 0 End If If bAlt Then keybd_event eKeys.keyAlt, 0, KEYEVENTF_KEYUP, 0 End If End If End If End Sub 'Purpose : Loops through a string and calls SendKey for each character 'Inputs : sString The string to press. ' [bDoEvents] If True returns control to the processor after every keypress. 'Outputs : N/A Public Sub SendString(ByVal sString As String, Optional bDoEvents As Boolean = True) Dim sKey As String * 1, lKey As Long, lLen As Long lLen = Len(sString) For lKey = 1 To lLen sKey = Mid$(sString, lKey, 1) SendKey sKey Sleep zlKeyPressDelay If bDoEvents Then DoEvents End If Next End Sub 'Purpose : Presses a virtual key (used for keys that don't have ascii equilivant) 'Inputs : ekeyPress The virtual key to press ' [bHoldKeydown] If True does not release the key press. ' [bRelease] If True releases the key press. ' [bCompatible] 'Outputs : N/A Public Sub PressKeyVK(ekeyPress As eKeys, Optional bHoldKeydown As Boolean, Optional bRelease As Boolean, Optional bCompatible As Boolean) Dim lScan As Long Dim lExtended As Long lScan = MapVirtualKey(ekeyPress, 2) lExtended = 0 If lScan = 0 Then lExtended = KEYEVENTF_EXTENDEDKEY End If lScan = MapVirtualKey(ekeyPress, 0) If bCompatible Then lExtended = 0 End If If Not bRelease Then keybd_event ekeyPress, lScan, lExtended, 0 End If If Not bHoldKeydown Then keybd_event ekeyPress, lScan, KEYEVENTF_KEYUP Or lExtended, 0 End If End Sub 'Purpose : Sets the status of the various Lock keys 'Inputs : LockKey The lock key to set the status of. 'Outputs : N/A Public Sub SetLockStatus(LockKey As eLockKey, bOn As Boolean) Dim abKeys(0 To 256) As Byte abKeys(LockKey) = (bOn * -1) 'Win 9x Call SetKeyboardState(abKeys(0)) If GetKeyState(LockKey) <> IIf(bOn, 0, 1) Then 'GetKeyState returns 1 if OFF and 0 if ON 'Win NT 'Simulate Key Press keybd_event LockKey, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0 'Simulate Key Release keybd_event LockKey, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0 End If End Sub 'Purpose : returns the status of the various Lock keys 'Inputs : LockKey The lock key to return the status of. 'Outputs : Returns True if the Lock status is on. Public Function GetLockStatus(LockKey As eLockKey) As Boolean GetLockStatus = GetKeyState(LockKey) End Function 'Determines the delay between subsequent keystrokes in the SendString routine Property Get KeyPressDelay() As Long KeyPressDelay = zlKeyPressDelay End Property Property Let KeyPressDelay(Value As Long) zlKeyPressDelay = Value End Property Private Sub Class_Initialize() zlKeyPressDelay = 20 'Add a delay of 20 ms between pressing each key End Sub