VBA从其他软件中复制数据到Excel中

最新推荐文章于 2024-08-13 08:39:15 发布

robot_大菜鸟

最新推荐文章于 2024-08-13 08:39:15 发布

阅读量1.5k

点赞数

分类专栏： VBA

本文链接：https://blog.csdn.net/weixin_45498306/article/details/113945319

版权

VBA 专栏收录该内容

11 篇文章 0 订阅

订阅专栏

在工作中，有时候会用到其他的数据，但是这些的软件不能直接调用，也不能导出数据，需要手动一个个的Ctrl+C,Ctrl+V，数据量大的时候，就比较繁琐，也占用了大量的时间，
正好会VBA，就用VBA来继续制作一个简单的ＲＰＡ。
目的：
使用ＶＢＡ通过sendkeys复制其他软件的信息，将内容复制粘贴到Excel中
操作方法：
VBA调用Sendkeys.

在这里插入图片描述

上代码：

Private Sub CommandButton1_Click()
    On Error Resume Next
    Dim count_row
    Dim MyData As DataObject
    Dim count_G
'最开始的时候，避免异常，停留1s。
    Application.Wait Now + TimeValue("00:00:01")
    ThisWorkbook.Activate
    count_n = Range("C1").Value
   ‘如果没有数据，则默认执行100次
    If TextBox1.Value = "" Then
        count_n = 100
    Else
        count_n = TextBox1.Value
    End If
   ’使用热键 “Alt + TAB” 进行运行程序的切换
    SendKeys "%{TAB}"
    For I = 1 To count_n
        If I = 1 Then
            Application.Wait Now + TimeValue("00:00:02")‘初始的时候避免异常，有个等待时间
        Else
            SendKeys "{down}", True’循环每次复制后，需要使用鼠标键向下移动
        End If
        TextBox2.Value = I’显示目前已经完成的数量
        count_G = Range("E100000").End(xlUp).Row + 1‘数据放到E列
        Get_V_Promaster = ""
        SendKeys "^c", True
        Set MyData = New DataObject
        MyData.GetFromClipboard
        Range("E" & count_G) = MyData.GetText
        Set MyData = Nothing
        If count_G > count_n * 0.5 Then‘退出的条件，最后几个数据一样就退出。
            If Range("E" & count_G) = Range("E" & count_G - 2) Then
                Exit For
            End If
        End If
        
    Next
    MsgBox "Done"
End Sub

参考代码，将sendkeys获取和清空剪贴板。

'清空bai系统剪du贴板zhi
Dim MyData As DataObject

Set MyData = New DataObject
MyData.SetText ""
MyData.PutInClipboard

'获取dao系统剪贴板数据

Dim MyData As DataObject
Dim strClip As String

Set MyData = New DataObject
MyData.GetFromClipboard
strClip = MyData.GetText