2012-12-15 2 views
2

다른 사람도 도움이되기를 바랍니다. 키보드 명령을 시뮬레이트하는 SendInput 코드 예제를 찾으려고합니다. 메모장 창을 찾고 테스트 메시지를 입력하고 싶습니다.SendInput VB 기본 예

내가 작업하고있는 프로젝트에서 처음에 SendKeys를 사용했지만 SendKeys 기능을 사용하여 직장에서 사용하는 맞춤형 소프트웨어에 키보드 명령을 전달할 수있었습니다.

누군가가 도울 수 있기를 바랍니다. 인터넷에서 예제가 작동하지 않는 것 같습니다.

SendInput 메서드가 방해가되는지, 즉받는 사람 창에 손상을 줄 수 있는지 조언 할 수있는 사람도 있습니다.

SendKey 메서드가 작동했지만 안정성이 매우 떨어졌고 누락 된 것 같습니다.

많은 감사

사라

편집 : 나는 인터넷에 다음 코드를 발견

, 다음은 SendInput을 방법은? 나는 'SendKey'라는 용어가 사용 된 것을 알고 있는가?

Private Declare Function SendInput Lib "user32.dll" _ 
(ByVal nInputs As Long, ByRef pInputs As Any, _ 
ByVal cbSize As Long) As Long 
Private Declare Function VkKeyScan Lib "user32" Alias "VkKeyScanA" _ 
(ByVal cChar As Byte) As Integer 

Private Type KeyboardInput  ' typedef struct tagINPUT { 
dwType As Long    '  DWORD type; 
wVK As Integer    '  union {MOUSEINPUT mi; 
wScan As Integer    '    KEYBDINPUT ki; 
dwFlags As Long    '    HARDWAREINPUT hi; 
dwTime As Long    '    }; 
dwExtraInfo As Long   '  }INPUT, *PINPUT; 
dwPadding As Currency   ' 8 extra bytes, because mouses take more. 
End Type 

Private Const INPUT_MOUSE As Long = 0 
Private Const INPUT_KEYBOARD As Long = 1 
Private Const KEYEVENTF_KEYUP As Long = 2 
Private Const VK_LSHIFT = &HA0 

Public Sub SendKey(ByVal Data As String) 
Dim ki() As KeyboardInput 
Dim i As Long 
Dim o As Long ' output buffer position 
Dim c As String ' character 

ReDim ki(1 To Len(Data) * 4) As KeyboardInput 
o = 1 

For i = 1 To Len(Data) 
c = Mid$(Data, i, 1) 
Select Case c 
    Case "A" To "Z": ' upper case 
    ki(o).dwType = INPUT_KEYBOARD 'shift down 
    ki(o).wVK = VK_LSHIFT 
    ki(o + 1) = ki(o) ' key down 
    ki(o + 1).wVK = VkKeyScan(Asc(c)) 
    ki(o + 2) = ki(o + 1) ' key up 
    ki(o + 2).dwFlags = KEYEVENTF_KEYUP 
    ki(o + 3) = ki(o) ' shift up 
    ki(o + 3).dwFlags = KEYEVENTF_KEYUP 
    o = o + 4 
    Case Else: ' lower case 
    ki(o).dwType = INPUT_KEYBOARD 
    ki(o).wVK = VkKeyScan(Asc(c)) 
    ki(o + 1) = ki(o) 
    ki(o + 1).dwFlags = KEYEVENTF_KEYUP 
    o = o + 2 
End Select 
Next i 

Debug.Print SendInput(o - 1, ki(1), LenB(ki(1))), 
Debug.Print Err.LastDllError 
End Sub 

Private Sub Command1_Click() 
Text1.Text = "" 
Text1.SetFocus 
DoEvents 
Call SendKey("This Is A Test") 
End Sub 
+0

vb.net이 아닌 VBA? – NickSlash

+0

죄송합니다 - vba 용입니다 – sara2011

+0

PtrSafe를 추가 할 때조차도 64 비트에서 작동하지 않습니다. – wtjones

답변

4

는 대상 응용 프로그램에 특별히 키를 전송으로 다음 코드는 VB.net하지만 그것에서 SendKeys의 방법과 유사하지만, 아마 조금 더 신뢰할 수있는 VB/VBA, 아닙니다. 당신은 엑셀/VBA에서 새 모듈에이 붙여 메모장 실행의 새로운 인스턴스가있는 경우

Public Declare Function FindWindowX Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, _ 
ByVal hWnd2 As Long, ByVal lpsz1 As Long, ByVal lpsz2 As Long) As Long 

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, _ 
ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Integer) As Long 

Private Const WM_KEYDOWN = &H100 
Private Const WM_KEYUP = &H101 

Sub Three() 
    hWind = FindWindow(vbNullString, "Untitled - Notepad") 
    cWind = FindWindowX(hWind, 0, 0, 0) 
    Debug.Print PostMessage(cWind, WM_KEYDOWN, vbKeyA, 0) 
    Debug.Print PostMessage(cWind, WM_KEYDOWN, vbKeyB, 0) 
    Debug.Print PostMessage(cWind, WM_KEYDOWN, vbKeyC, 0) 
End Sub 

코드 this 포럼 게시물

에서 가져온 (내가 그것을 가지고 포스트는 너무에서 SendKeys 방법을 보여줍니다) , 하위가 실행될 때 "abc"가 메모장에 나타나야합니다.

이것을 사용하는 방법이 보이지 않거나 sendkeys 메서드가 대상 창을 "손상"시킬 수 있습니다. 당신이 메시지를 적절하게 시간을 재는 한 (동시에 모든 시간에 문자 톤을 전송하지 않음) 아무런 문제가 없어야합니다.

+0

감사합니다. Nick, 현재 SendMessage 또는 PostMessage 대신 SendInput 메서드를 사용하고 있습니다. – sara2011

0

다른 SendInput 스크립트를 온라인에서 찾을 수 있었기 때문에 관심이있는 다른 사용자를 위해 아래에 복사했습니다.

저는 스프레드 시트에서 데이터를 복사하고 직장에서 시스템에 이러한 데이터를 입력하기 위해 SendKeys를 사용하고 있습니다. 이렇게하면 많은 양의 정보를 입력해야하므로 귀중한 시간을 절약 할 수 있습니다.

SendKeys 함수는 아무런 문제없이 작동했지만 (대안을 고려해야했던 안정성 문제로 인해) SendInput은 다른 창 (예 : 키보드 단추를 시뮬레이트하는 것 이외의 다른 문제가 대상의 다른 기능을 방해 함)에 문제가 발생합니까? 창문?

Private Declare Function SendInput Lib "user32.dll" _ 
(ByVal nInputs As Long, ByRef pInputs As Any, _ 
ByVal cbSize As Long) As Long 
Private Declare Function VkKeyScan Lib "user32" Alias "VkKeyScanA" _ 
(ByVal cChar As Byte) As Integer 

Private Type KeyboardInput  ' typedef struct tagINPUT { 
dwType As Long    '  DWORD type; 
wVK As Integer    '  union {MOUSEINPUT mi; 
wScan As Integer    '    KEYBDINPUT ki; 
dwFlags As Long    '    HARDWAREINPUT hi; 
dwTime As Long    '    }; 
dwExtraInfo As Long   '  }INPUT, *PINPUT; 
dwPadding As Currency   ' 8 extra bytes, because mouses take more. 
End Type 

Private Const INPUT_MOUSE As Long = 0 
Private Const INPUT_KEYBOARD As Long = 1 
Private Const KEYEVENTF_KEYUP As Long = 2 
Private Const VK_LSHIFT = &HA0 

Public Sub SendKey(ByVal Data As String) 
Dim ki() As KeyboardInput 
Dim i As Long 
Dim o As Long ' output buffer position 
Dim c As String ' character 

ReDim ki(1 To Len(Data) * 4) As KeyboardInput 
o = 1 

For i = 1 To Len(Data) 
c = Mid$(Data, i, 1) 
Select Case c 
    Case "A" To "Z": ' upper case 
    ki(o).dwType = INPUT_KEYBOARD 'shift down 
    ki(o).wVK = VK_LSHIFT 
    ki(o + 1) = ki(o) ' key down 
    ki(o + 1).wVK = VkKeyScan(Asc(c)) 
    ki(o + 2) = ki(o + 1) ' key up 
    ki(o + 2).dwFlags = KEYEVENTF_KEYUP 
    ki(o + 3) = ki(o) ' shift up 
    ki(o + 3).dwFlags = KEYEVENTF_KEYUP 
    o = o + 4 
    Case Else: ' lower case 
    ki(o).dwType = INPUT_KEYBOARD 
    ki(o).wVK = VkKeyScan(Asc(c)) 
    ki(o + 1) = ki(o) 
    ki(o + 1).dwFlags = KEYEVENTF_KEYUP 
    o = o + 2 
End Select 
Next i 

Debug.Print SendInput(o - 1, ki(1), LenB(ki(1))), 
'Debug.Print Err.LastDllError 
End Sub 

Private Sub Command1_Click() 
Text1.Text = "" 
Text1.SetFocus 
DoEvents 
Call SendKey("This Is A Test") 
End Sub