vba SendInput VB 基本示例

SendInput VB Basic Example

提问by sara2011

I hope someone can assist, I trying to find an example of a SendInput code that simulate keyboard commands, I wish to find the notepad window and enter a test message.

我希望有人可以提供帮助，我试图找到一个模拟键盘命令的 SendInput 代码示例，我希望找到记事本窗口并输入测试消息。

I had initially used SendKeys on a project I am working on, the SendKeys function enabled me to forward keyboard commands to a bespoke software that we are use at our workplace.

我最初在我正在从事的项目中使用 SendKeys，SendKeys 功能使我能够将键盘命令转发到我们在工作场所使用的定制软件。

I hope someone can help, the examples on the internet does not seem to work.

我希望有人可以提供帮助，互联网上的示例似乎不起作用。

Can anyone also advise if the SendInput method is intrusive, i.e. will it cause any damage to the recipient window.

任何人都可以建议 SendInput 方法是否具有侵入性，即它是否会对收件人窗口造成任何损坏。

The SendKey method worked, however the reliability seems to be very hit and miss.

SendKey 方法有效，但是可靠性似乎很受打击。

Many Thanks

非常感谢

Sara

萨拉

Edit:

编辑：

I have found the following code on the internet, is the following a SendInput method? As I notice that term 'SendKey' is used?

我在网上找到了下面的代码，下面是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

回答by NickSlash

The following code is not for VB.net but VB/VBA, its similar to the sendkeys method but probably a little more reliable as it sends the keys specifically to the target application. (the post where i got it shows the sendkeys method too)

以下代码不是针对 VB.net 而是针对 VB/VBA，它类似于 sendkeys 方法，但可能更可靠一些，因为它专门将密钥发送到目标应用程序。（我得到它的帖子也显示了 sendkeys 方法）

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

Code taken from thisforum post

取自此论坛帖子的代码

If you paste this into a new module in Excel/VBA and have an new instance of notepad running, when the sub is executed "abc" should appear in notepad.

如果将其粘贴到 Excel/VBA 中的新模块中并运行记事本的新实例，则执行 sub 时，“abc”应出现在记事本中。

I don't see how using this, or the sendkeys method could "damage" the target window. So long as you time the messages properly (not sending tonnes of characters to the window all at the same time) it shouldn't cause any problems.

我不知道如何使用它，或者 sendkeys 方法会“损坏”目标窗口。只要您正确地为消息计时（不是同时向窗口发送大量字符），就不应该引起任何问题。

回答by sara2011

I had managed to find another SendInput script online, I have copied it below for anyone else who may be interested.

我设法在网上找到了另一个 SendInput 脚本，我已将其复制到下面以供其他可能感兴趣的人使用。

I have been using SendKeys to copy data from a spreadsheet and enter these on a system at work, this saves valuable time as there is a vast amount of information that needs to be entered.

我一直在使用 SendKeys 从电子表格中复制数据并在工作中的系统上输入这些数据，这节省了宝贵的时间，因为需要输入大量信息。

The SendKeys function worked without any issues (although due to reliability issues I had to consider alternatives), will the SendInput cause any issues to the other window i.e. other than simulating keyboard buttons will it interfere with any other functions of the target window?

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