用VBA模拟键盘输入

yynrzwh

最近由于工作需要，把表格里的数据录入单位内部系统的窗口，系统老旧没有导入Excel数据功能。
窗口有17个录入数据的文本框，第5，7，8文本框后有复选框要打勾。
有大量数据要录入，一个个复制粘贴实在太痛苦了！
于是我研究了下，写了以下半手工的代码：
1：
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub 复制粘贴到新窗口1()
Application.ScreenUpdating = False
AppActivate "窗口标题"'根据窗口标题激活录入窗口
t = 200
For i = 4 To 20
    Sleep t: Cells(i, 3).Copy: Sleep t: SendKeys "^v": Sleep t: SendKeys "{ENTER}"
    If i = 8 Or i = 10 Or i = 11 Then
        Sleep t: SendKeys " ": Sleep t: SendKeys "{ENTER}"
    End If
Next
Application.ScreenUpdating = True
End Sub

2：
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub 复制粘贴到新窗口2()
Dim mydata As dataobject 'Microsoft Forms 2.0 object library.注意：参考库不会显示在列表。
'如果没有，请浏览FM20.DLL文件
Set mydata = New dataobject
AppActivate "窗口标题"
t = 100
    For i = 4 To 20
        mydata.settext Cells(i, 3).Value
        mydata.putinclipboard
        Sleep t: SendKeys "^v": Sleep t: SendKeys "{ENTER}": Sleep t
        If i = 8 Or i = 10 Or i = 11 Then
            Sleep t: SendKeys " ": Sleep t: SendKeys "{ENTER}"
        End If

    'mydata.GetFromClipboard
    'strclip = mydata.gettext

    Next
End Sub

3：
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds 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)
Sub PasteData()
    '定义窗口标题和各文本框的 ID
    Const WINDOW_TITLE As String = "窗口标题"
'    Const TEXTBOX_IDS As String ="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19"
    AppActivate WINDOW_TITLE '激活窗口
    Sleep 500
    t = 100
    Dim i As Integer
        For i = 4 To 20 '将数据逐个复制到窗口
            Range("C" & i).Copy '将当前单元格复制到剪贴板
            Sleep t
            keybd_event &H11, 0, 0, 0: keybd_event &H56, 0, 0, 0: keybd_event &H56, 0, 2, 0: keybd_event &H11, 0, 2, 0
            'Ctrl+V键'将数据粘贴到文本框
            Sleep t   '等待一段时间
            keybd_event 8, 0, 0, 0: keybd_event 8, 0, 2, 0   '退格键
            Sleep t
            If i = 8 Or i = 10 Or i = 11 Then
                keybd_event &HD, 0, 0, 0: keybd_event &HD, 0, 2, 0  'Enter键
                Sleep t
                keybd_event 32, 0, 0, 0: keybd_event 32, 0, 2, 0 '空格键
                Sleep t
            End If
            keybd_event &HD, 0, 0, 0: keybd_event &HD, 0, 2, 0   'Enter键，进入下一个文本框
            Sleep t
        Next i

    '按下保存按钮
'    keybd_event &H11, 0, 0, 0   'Ctrl键
'    keybd_event &HS, 0, 0, 0   'S键
'    keybd_event &HS, 0, 2, 0
'    keybd_event &H11, 0, 2, 0
'
'    Sleep 1000   '等待保存完成
'
'    '按下退出按钮
'    keybd_event &H11, 0, 0, 0   'Ctrl键
'    keybd_event &HQ, 0, 0, 0   'Q键
'    keybd_event &HQ, 0, 2, 0
'    keybd_event &H11, 0, 2, 0

    Sleep 500   '等待程序退出

End Sub

具体功能就是复制单元格的值，粘贴到录入窗口第一个文本框（激活窗口后自带焦点），输入回车键到第二个文本框，循环复制粘贴。
遇到有复选框的行，要回车跳到复选框，输入空格选择，再回车跳到下一个文本框。
第1、2段代码似乎成功率不高，有时会有无响应的问题（响应时间过长，粘贴的数据顺序全乱了）。第3段就好多了。
代码是网上找或问chatGPT的，自己修改下。代码虽然简单，但对我这种生手来说还是好难，而且网上这种的资料也不多，
这种代码调试还不好下断点。期间问过很多次GPT，有参考价值但也有不靠谱的，直接抄就没试过成功的！
GPT和网上资料也有说用SendMessage或postmessage的，但我没试成功，就不贴上来了。
欢迎大佬提供更好的方法！感谢！

ykcbf1100

上个附件参考一下啊。

yynrzwh

发现这种消息循环的要加 DoEvents，可以解决无响应问题！

第2段        mydata.settext Cells(i, 3).Value     
                mydata.putinclipboard
之间也应该加sleep 延时，否则有时会失败！
说明：模块4和模块9是我贴出来的第1、2段代码，其它的都是没成功的
贴出来的第3段代码不在家里电脑上，不好意思

yynrzwh

ykcbf1100 发表于 2023-4-14 13:38
上个附件参考一下啊。

OK，就上   

xj123321

学习学习   

zshyaw

我们一直在使用免费的Dataload这个软件,设置好模板就行,.

你地铁图

模拟键盘不稳定

yynrzwh

你地铁图 发表于 2023-4-17 23:51
模拟键盘不稳定

我的电脑运行还行，不同的电脑要调试。总的来说不是理想的方式。

yynrzwh

zshyaw 发表于 2023-4-17 10:57
我们一直在使用免费的Dataload这个软件,设置好模板就行,.

方便提供下软件吗？

zshyaw

网上百度搜一下免安装版本,好多连接呢