想用VBA API 模拟按键

志65

我想要复制内容到网页邮箱，可是我发现若是用模拟键alt+tab的话，下面2个模拟键 ctrl+v 和 tab就无效的，应该是要有代码写明选中网页才可以，如代码中是选中第2个工作薄来操作下面的2个模拟按键ctrl+v 和 tab，那么选中网页代码又该如何写？

*****是代表r32，本来是user32.dll，可能上传后，网页会修改为星号

Public Declare Sub keybd_event Lib "use*****.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const KEYEVENTF_KEYUP = &H2
Const VK_TAB = &H9

Sub 按键切换()
Rem 模拟按alt+tab组合键
Call keybd_event(18, 0, 0, 0)
Call keybd_event(9, 0, 0, 0)
Call keybd_event(18, 0, KEYEVENTF_KEYUP, 0)
Call keybd_event(9, 0, KEYEVENTF_KEYUP, 0)
End Sub

Sub 按键粘贴()
Rem 模拟组合键ctrl+v
Call keybd_event(17, 0, 0, 0)
Call keybd_event(86, 0, 0, 0)
Call keybd_event(17, 0, KEYEVENTF_KEYUP, 0)
Call keybd_event(86, 0, KEYEVENTF_KEYUP, 0)
End Sub

Sub 按键tab()
Rem 模拟按tab键
Call keybd_event(9, 0, 0, 0)
Call keybd_event(9, 0, KEYEVENTF_KEYUP, 0)
End Sub

Sub 标题() '把区域文本数据复制到 粘贴板
     Dim c As Range, t As String
    For Each c In Range("C2：C2")
        t = t & c & vbCrLf
    Next

    Set MyData = New DataObject
        With MyData
            .SetText t
            .PutInClipboard
        End With

    Set MyData = Nothing
End Sub

Sub 复制信息到其他地方()
Dim c As Range, t As String
Dim b, f As Integer
b = Cells.Find("邮箱").Column
f = Cells.Find("邮件内容").Column

If Selection.Value <> "" And Selection.Column > b - 1 And Selection.Column < f + 1 Then
    For Each c In Selection
        t = t & c & vbCrLf
    Next

    Set MyData = New DataObject
        With MyData
            .SetText t
            .PutInClipboard
        End With
    Set MyData = Nothing
Cells(Selection.Row, Selection.Column + 1).Select

Rem 我尝试了用切换组合键，发现若是用了切换组合键（ALT+TAB）的话，下面2个按键的代码就无效，也不知为何。
Workbooks(2).Activate
Rem 添加选中当前邮箱网页的界面代码
Call 按键粘贴
Call 按键tab

End If

If Selection.Column = f + 1 Then
    For Each c In Selection
        t = t & c & vbCrLf
    Next

    Set MyData = New DataObject
        With MyData
            .SetText t
            .PutInClipboard
        End With
    Set MyData = Nothing
Cells(Selection.Row + 1, b).Select

Workbooks(2).Activate
Rem 添加选中当前邮箱网页的界面代码 如workbooks(2).activate
Call 按键粘贴
Call 按键tab

End If
End Sub

一把小刀闯天下

Const KEYEVENTF_KEYUP = &H2

插入到API函数下面再试试，，，

志65

一把小刀闯天下 发表于 2019-10-13 13:10
Const KEYEVENTF_KEYUP = &H2

插入到API函数下面再试试，，，

还是不行，还是提示缺少函数和变量

一把小刀闯天下

志65 发表于 2019-10-13 14:11
还是不行，还是提示缺少函数和变量

'试了一下应该可以的，，，]-----------

志65

一把小刀闯天下 发表于 2019-10-13 14:27
'试了一下应该可以的，，，]-----------

我参考了其他人的，代码如下，
Public Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const KEYEVENTF_KEYUP = &H2
Const VK_TAB = &H9

Sub 按键切换()
Rem 模拟按alt+tab组合键
Call keybd_event(18, 0, 0, 0)
Call keybd_event(9, 0, 0, 0)
Call keybd_event(18, 0, KEYEVENTF_KEYUP, 0)
Call keybd_event(9, 0, KEYEVENTF_KEYUP, 0)
End Sub


这样就可以了。

但是我想要切换后，直接粘贴内容，可是第2个模拟键粘贴就无效了。

Public Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const KEYEVENTF_KEYUP = &H2
Const VK_TAB = &H9

Sub 按键切换()
Rem 模拟按alt+tab组合键
Call keybd_event(18, 0, 0, 0)
Call keybd_event(9, 0, 0, 0)
Call keybd_event(18, 0, KEYEVENTF_KEYUP, 0)
Call keybd_event(9, 0, KEYEVENTF_KEYUP, 0)
End Sub

Sub 按键粘贴()
Rem 模拟按alt+tab组合键
Call keybd_event(17, 0, 0, 0)
Call keybd_event(86, 0, 0, 0)
Call keybd_event(17, 0, KEYEVENTF_KEYUP, 0)
Call keybd_event(86, 0, KEYEVENTF_KEYUP, 0)
End Sub


Sub 复制信息到其他地方()
Dim c As Range, t As String
Dim b, f As Integer
b = Cells.Find("邮箱").Column
f = Cells.Find("邮件内容").Column

If Selection.Value <> "" And Selection.Column > b - 1 And Selection.Column < f + 1 Then
    For Each c In Selection
        t = t & c & vbCrLf
    Next

    Set MyData = New DataObject
        With MyData
            .SetText t
            .PutInClipboard
        End With
    Set MyData = Nothing
Cells(Selection.Row, Selection.Column + 1).Select
Call 按键切换
Call 按键粘贴
End If
If Selection.Column = f + 1 Then
    For Each c In Selection
        t = t & c & vbCrLf
    Next

    Set MyData = New DataObject
        With MyData
            .SetText t
            .PutInClipboard
        End With
    Set MyData = Nothing
Cells(Selection.Row + 1, b).Select

Call 按键切换
Call 按键粘贴
End If
End Sub


第一次粘贴是可以的，到下次粘贴就无效了，这是为何？

志65

一把小刀闯天下 发表于 2019-10-13 14:27
'试了一下应该可以的，，，]-----------

我尝试了用切换组合键，发现若是用了切换组合键（ALT+TAB）的话，下面2个按键的代码就无效，也不知为何。
Workbooks(2).Activate，我这是切换到第2个工作簿，那么若是切换到网页，代码又该如何写？


Public Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const KEYEVENTF_KEYUP = &H2
Const VK_TAB = &H9

Sub 按键切换()
Rem 模拟按alt+tab组合键
Call keybd_event(18, 0, 0, 0)
Call keybd_event(9, 0, 0, 0)
Call keybd_event(18, 0, KEYEVENTF_KEYUP, 0)
Call keybd_event(9, 0, KEYEVENTF_KEYUP, 0)
End Sub

Sub 按键粘贴()
Rem 模拟组合键ctrl+v
Call keybd_event(17, 0, 0, 0)
Call keybd_event(86, 0, 0, 0)
Call keybd_event(17, 0, KEYEVENTF_KEYUP, 0)
Call keybd_event(86, 0, KEYEVENTF_KEYUP, 0)
End Sub

Sub 按键tab()
Rem 模拟按tab键
Call keybd_event(9, 0, 0, 0)
Call keybd_event(9, 0, KEYEVENTF_KEYUP, 0)
End Sub


Sub 标题() '把区域文本数据复制到 粘贴板
     Dim c As Range, t As String
    For Each c In Range("C2：C2")
        t = t & c & vbCrLf
    Next
   
    Set MyData = New DataObject
        With MyData
            .SetText t
            .PutInClipboard
        End With
        
    Set MyData = Nothing
End Sub

Sub 复制信息到其他地方()
Dim c As Range, t As String
Dim b, f As Integer
b = Cells.Find("邮箱").Column
f = Cells.Find("邮件内容").Column

If Selection.Value <> "" And Selection.Column > b - 1 And Selection.Column < f + 1 Then
    For Each c In Selection
        t = t & c & vbCrLf
    Next
   
    Set MyData = New DataObject
        With MyData
            .SetText t
            .PutInClipboard
        End With
    Set MyData = Nothing
Cells(Selection.Row, Selection.Column + 1).Select

Rem 我尝试了用切换组合键，发现若是用了切换组合键（ALT+TAB）的话，下面2个按键的代码就无效，也不知为何。rem 如下是切换到第2个工作簿，那么若是切换到网页，如何实现？
Workbooks(2).Activate
Rem 添加选中当前邮箱网页的界面代码
Call 按键粘贴
Call 按键tab

End If

If Selection.Column = f + 1 Then
    For Each c In Selection
        t = t & c & vbCrLf
    Next
   
    Set MyData = New DataObject
        With MyData
            .SetText t
            .PutInClipboard
        End With
    Set MyData = Nothing
Cells(Selection.Row + 1, b).Select

Rem 我尝试了用切换组合键，发现若是用了切换组合键（ALT+TAB）的话，下面2个按键的代码就无效，也不知为何。rem 如下是切换到第2个工作簿，那么若是切换到网页，如何实现？
Workbooks(2).Activate
Call 按键粘贴
Call 按键tab

End If
End Sub

一把小刀闯天下

大概看了一下，想要发送些东西到网页邮&箱，可以理解为最终是要发送you&jian。那就在VBA中直接发送you&jian好了，不要去控制组合键了，而且用你这方法当前页面很容易失去焦点的，也就是并不可靠，，，

志65

一把小刀闯天下 发表于 2019-10-13 21:02
大概看了一下，想要发送些东西到网页邮&箱，可以理解为最终是要发送you&jian。那就在VBA中直接发送you&jian ...

you&jian ??? 这是啥？

我是来讨说法的

vba本来就可以发送邮件，而不需要打开邮箱

志65

我是来讨说法的 发表于 2019-10-14 09:37
vba本来就可以发送邮件，而不需要打开邮箱

我试过，但是不行，应该会受限制的，没发几封就发不出去了，所以用网页版一个个发的话，就不会受限制