使用VBA按网页上的按钮,无需打开IE

时间:2015-11-04 17:45:29

标签: javascript jquery html vba internet-explorer

我想知道是否可以点击按钮"在网页上没有在IE中打开页面。网页是动态生成的,点击按钮会调用更改页面内容的脚本。

我可以使用此子句打开Internet Explorer:

Sub DownloadPageScript(strUrl As String, htmlPage As htmlDocument, strScript As String)

  Dim IE            As Object

  Set IE = CreateObject("InternetExplorer.application")
  IE.navigate strUrl

  Do
      DoEvents
  Loop Until IE.ReadyState = READYSTATE_COMPLETE 

  ' Run the scripts associated to the button to get the data
  IE.Document.parentWindow.execScript strScript, "jscript"

  Do
      DoEvents
  Loop Until IE.ReadyState = READYSTATE_COMPLETE

  Set htmlPage = IE.Document

End Sub

但我想避免打开Internet Explorer,所以我希望这样:

Sub Download_Page(strUrl As String, htmlPage As htmlDocument, strScript As String)

  Dim xmlHttp      As Object
  '
  Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
  xmlHttp.Open "GET", strUrl, False
  xmlHttp.setRequestHeader "Content-Type", "text/xml"
  xmlHttp.send
  '
  ' Here I should add something to execute the script
  ' 
  ' After execution
  '
  Set htmlPage = New htmlDocument
  htmlPage.body.innerHTML = xmlHttp.ResponseText
  '
End Sub

我期待找到类似xmlHttp.execute(args)方法的东西来复制点击按钮的动作,但我错了。 所以我的问题是:如果我不想打开Internet Explorer,是否可以复制按钮单击?如果是,我该怎么办?

基于评论中的想法的新方法

我在评论中尝试了@omegastripes建议的方法,我在他的回答中写下了这个子句33484763

Sub TestDownload()

  Dim xmlHttp      As Object
  Dim htmlPage       As htmlDocument
  Dim strExportURL   As String
  Dim strFormData    As Variant
  Dim strContent     As String


    ' build exportURL parameter
  strExportURL = Join(Array( _
      "p_p_id=ScommesseAntepostPalinsesto_WAR_scommesseportle", _
      "p_p_lifecycle=2", _
      "p_p_resource_id=dettagliManifestazione", _
      "p_p_cacheability=cacheLevelPage", _
      "_ScommesseAntepostPalinsesto_WAR_scommesseportlet_codDisc=1", _
      "_ScommesseAntepostPalinsesto_WAR_scommesseportlet_codMan=21", _
      "_ScommesseAntepostPalinsesto_WAR_scommesseportlet_codScomm=3", _
      "_ScommesseAntepostPalinsesto_WAR_scommesseportlet_codClusterScomm=80", _
      "_ScommesseAntepostPalinsesto_WAR_scommesseportlet_filtro=0" _
      ), "&")

  ' build the whole form data
  strFormData = Join(Array( _
        "languageCode=en", _
        "exportURL=" & URLEncode(strExportURL) _
    ), "&")

  ' POST XHR to retrieve the content
  Set xmlHttp = CreateObject("Microsoft.XMLHTTP")
  xmlHttp.Open "POST", "http://www.sisal.it/scommesse-matchpoint/palinsesto", False
  xmlHttp.setRequestHeader "Content-Type", "application/json"
  xmlHttp.send strFormData

  Set htmlPage = New htmlDocument
  htmlPage.body.innerHTML = xmlHttp.responseText
  '
End Sub

Public Function URLEncode( _
   StringVal As String, _
   Optional SpaceAsPlus As Boolean = False _
) As String
  Dim bytes() As Byte, b As Byte, i As Integer, space As String

  If SpaceAsPlus Then space = "+" Else space = "%20"

  If Len(StringVal) > 0 Then
    With New ADODB.Stream
      .Mode = adModeReadWrite
      .Type = adTypeText
      .Charset = "UTF-8"
      .Open
      .WriteText StringVal
      .Position = 0
      .Type = adTypeBinary
      .Position = 3 ' skip BOM
      bytes = .Read
    End With

    ReDim result(UBound(bytes)) As String

    For i = UBound(bytes) To 0 Step -1
      b = bytes(i)
      Select Case b
        Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
          result(i) = Chr(b)
        Case 32
          result(i) = space
        Case 0 To 15
          result(i) = "%0" & Hex(b)
        Case Else
          result(i) = "%" & Hex(b)
      End Select
    Next i

    URLEncode = Join(result, "")
  End If
End Function

URLEncode()功能来自此帖子URLEncode。 (我尝试使用JScriptControl,但它不起作用可能是因为我有Office 64位)。

此代码运行时没有错误,但是当我查看htmlPage的内容时,它几乎是空的。我认为问题是我发送的请求是错误的,但我无法纠正,你能帮助我吗?

1 个答案:

答案 0 :(得分:1)

考虑以下示例:

-collectionViewContentSize

输出结果为:

output

对于页面上的实际表格:

table

希望这有帮助。