我正在尝试使这个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