VBA XML身份验证&屏幕抓取网页以擅长

时间:2018-04-02 08:19:38

标签: xml excel vba excel-vba authentication

我正在尝试使这个VBA XML脚本在需要身份验证的网站上运行,但我还没有正确的身份验证部分才能正常工作。我需要帮助。

下面的XML代码似乎运行正常,它复制了大多数记录&粘贴到Excel工作表但输出缺少实际的出生日期信息&实际的出生地信息。

以下是目前为止的代码,它用于复制数据表记录:

'衷心感谢和赞赏@SIM对以下部分代码的意见。

Private Function Escape(ByVal URL As String) As String

    Dim i As Integer, BadChars As String
    BadChars = "<>%=&!@#£$^()+{[}]|\;:'"",/?"

    For i = 1 To Len(BadChars)

        URL = Replace(URL, Mid(BadChars, i, 1), "%" & Hex(Asc(Mid(BadChars, i, 1))))
    Next i

    URL = Replace(URL, " ", "+")
    Escape = URL

End Function

Sub GetDataWithXmlSearch()  

    Dim HTMLdoc As HTMLDocument, HTMLdoc2 As HTMLDocument
    Dim URL As String
    Dim username As String, password As String
    Dim HTTP As New XMLHTTP60
    Dim html As New HTMLDocument
    Dim posts As Object
    Dim elem As Object
    Dim trow As Object
    Dim QuerySP$
    Dim LINK$
    Dim i&
    Dim c As Long 
    Dim r As Long 

    username = "myusername"
    password = "mypassword"
    URL = "https://www.ancestry.com.au/secure/login
    Set HTMLdoc2 = New HTMLDocument
    Set HTMLdoc = HTMLdoc2.createDocumentFromUrl(URL, "")

    While HTMLdoc.ReadyState <> "complete": DoEvents: Wend

    LINK = "https://search.ancestry.com.au/cgi-bin/sse.dll?" 'thanks SIM

    For i = 50 To 15000 Step 50   

        QuerySP = "_phsrc=xNG92&_phstart=successSource&usePUBJs=true&db=FS1ScotlandBirthsandBaptisms&gss=angs-d&new=1&rank=1&msbdy=1900&msbdy_x=1&msbdp=10&MSAV=1&uidh=000&gl=&gst=&hc=50&fh=11500&fsk=BEIgT4gIgADq7wAvWKY-61-&fh=" & i & ""

        With HTTP
            .Open "GET", LINK & QuerySP, False
            .send
            html.body.innerHTML = .responseText
        End With

        Set posts = html.getElementById("results-main").getElementsByTagName("table")(0)

        For Each elem In posts.Rows
            For Each trow In elem.Cells
                c = c + 1: Cells(r + 1, c) = trow.innerText
            Next trow
            c = 0: r = r + 1
        Next elem

    Next i

End Sub

0 个答案:

没有答案