【问题标题】:Web-scrape data without class name or ID没有类名或 ID 的网络抓取数据
【发布时间】:2020-09-26 16:53:24
【问题描述】:

我正在尝试在站点中进行访问登录并从中获取一些数据 那是我的代码:

Private Sub Command4_Click()

Dim i As SHDocVw.InternetExplorer
Dim ht As HTMLDocument

Set i = New InternetExplorer
i.Visible = True
i.navigate ("https://billing.te.eg/en-US")
Do While i.ReadyState <> READYSTATE_COMPLETE
Loop
Dim idoc As MSHTML.HTMLDocument
Set idoc = i.Document
idoc.all.TxtAreaCode.Value = "45"
idoc.all.TxtPhoneNumber.Value = "03824149"
Dim ele As MSHTML.IHTMLElement
Dim eles As MSHTML.IHTMLElementCollection
Set eles = idoc.getElementsByClassName("btn")
For Each ele In eles
   If ele.Type = "button" Then
      ele.Click
   Else
   End If
Next ele
Do While i.ReadyState <> READYSTATE_COMPLETE
Loop
If i.ReadyState = READYSTATE_COMPLETE Then
   Dim Doc As HTMLDocument
   Set Doc = i.Document
   Dim sdd As String
    sdd = Trim(Doc.getElementsByClassName("col-md-12").innerText)
   MsgBox sdd
Else: End If
End Sub

这是我需要获取数据的部分,我需要知道如何获取没有类名或 ID 的数据,例如

【问题讨论】:

标签: vba ms-access web-scraping


【解决方案1】:

尝试遵循以下方法。它比 IE 快得多。

Sub FetchData()
    Const Url$ = "https://billing.te.eg/api/Account/Inquiry"
    Dim S$, elem As Object, payload As Variant
    Dim phone$, areaCode$, counter&

    counter = 1
    areaCode = "45"        'put areacode here
    phone = "03824149"     'put phone number here

    payload = "AreaCode=" & areaCode & "&PhoneNumber=" & phone & "&PinCode=&InquiryBy=telephone&AccountNo="

    Do
        With CreateObject("MSXML2.XMLHTTP")
            .Open "POST", Url, False
            .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; ) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/83.0.4103.61 Safari/537.36"
            .setRequestHeader "Referer", "https://billing.te.eg/en-US"
            .setRequestHeader "X-Requested-With", "XMLHttpRequest"
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
            .send payload
            S = .responseText
        End With

        With CreateObject("VBScript.RegExp")
            .Global = True
            .MultiLine = True
            .Pattern = "TotalAmount"":(.*?),"
            Set elem = .Execute(S)
            If elem.Count > 0 Then
                MsgBox elem(0).SubMatches(0)
                Exit Do
            End If
        End With

        counter = counter + 1
        If counter = 3 Then Exit Do
    Loop
End Sub

【讨论】:

  • 脚本需要运行两次才能得到结果,这真的很奇怪。但是,我创建了一个循环来解决这个问题。谢谢。
  • 哇,兄弟,这工作得非常快,我应该学什么这样的代码???我只有一些基本的 vba 和访问权限
猜你喜欢
  • 1970-01-01
  • 2017-05-20
  • 2019-03-25
  • 2016-03-11
  • 2021-05-29
  • 1970-01-01
  • 1970-01-01
  • 2014-12-15
  • 1970-01-01
相关资源
最近更新 更多