VBA脚本与FireFox浏览器交互

时间:2016-12-23 10:15:27

标签: vba excel-vba excel

我正在尝试创建VBA工具,将excel工作簿中的一些数据复制粘贴到我们通过浏览器使用的某个内部公司应用程序。该程序应该"点击"几个按钮和复选框,并将单元格值粘贴到以下屏幕上显示的文本框中:

SS1

SS2

SC3

不幸的是,有几个限制:

  • 此网站无法在MS Internet Explorer上运行。我只能通过FireFox使用它。
  • 由于may公司的安全规则,我无法安装任何软件。因此,我不能使用Selenium(需要安装附加组件),也不能使用R或Python执行此任务。
  • 点击Tab密钥无效,因此我无法多次SendKeys "{TAB}"次。

有人知道如何解决这个问题吗?

1 个答案:

答案 0 :(得分:1)

<强> 解决方法:
当你陈述唯一的解决方案(根据我的知识,因为Firefox没有api)会点击并等待几个 - 是否有任何窗口可能会弹出以验证你已完成? - 。


步骤:
1.将firefox窗口设置在一个恒定位置,然后获取坐标
您需要声明每个坐标,您可以使用以下代码来帮助您计算坐标,如下所示:

Dim MyPointAPI As POINTAPI
Private Type POINTAPI
  X As Long
  Y As Long
End Type
Private Declare Function GETCURSORPOS Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Public Sub MouseCursorGetOurXY()
'this was taken online quite a while ago, left everything as copied from the original source
    Dim L As Long
Application.Wait (Now() + TimeValue("00:00:02"))
    L = GETCURSORPOS(MyPointAPI) 'get our cursor position first
    MsgBox CStr(MyPointAPI.X) & ", " & CStr(MyPointAPI.Y) 'displays cursor X Y coordinates
End Sub

enter image description here


2.使用以下坐标设置代码:

 Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Sub Click_Windows()
    Const CheckBoxCoordX As Long = 455
    Const CheckBoxCoordY As Long = 300
    Const InputBoxCoordX As Long = 155
    Const InputBoxCoordY As Long = 255
    Const FireFoxWindowTitle As String = "WebPage Title"
    Dim do_Mydata As DataObject
    Dim lHnd As Long
    Dim i As Long
    lHnd = FindWindow(vbNullString, FireFoxWindowTitle)
    If lHnd > 0 Then 'This means that your program is in memory ' 1. If lHnd > 0
    'Now that You've already checked your app is running then ..
    AppActivate FireFoxWindowTitle
    Else ' 1. If lHnd > 0
    i = 0
    Do Until lHnd > 0
    lHnd = FindWindow(vbNullString, FireFoxWindowTitle)
    If i < 5 Then ' 2. If i < 5
    Application.Wait (Now() + TimeValue("00:00:01"))
    i = i + 1
    Else ' 2. If i < 5
    MsgBox ("It seems that the webpage is not opened!")
    End
    End If ' 2. If i < 5
    Loop
    End If ' 1. If lHnd > 0
        'code to click only
       SetCursorPos CheckBoxCoordX, CheckBoxCoordY
       mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
       mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
       Application.Wait (Now() + TimeValue("00:00:01"))
       'move to the input box and paste data from excel
       SetCursorPos InputBoxCoordX, InputBoxCoordY
       mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
       mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
        Set do_Mydata = New DataObject
        With do_Mydata
            .SetText Range("A1").Value
            .PutInClipboard
        End With
        SendKeys "^v", True
        Set do_Mydata = Nothing
        Application.CutCopyMode = False

    End Sub