【发布时间】:2019-10-10 19:08:25
【问题描述】:
我想从www.181.bh 收集数据(名称)。本网站使用 POST 方式,不允许通过 URL 改变搜索。
我正在使用 Excel VB 宏在以下代码的帮助下收集数据。我需要收集从 A 到 Z 的名称。对于提供的代码,我过去常常通过 URL 帮助获取它,但由于它使用 POST 方法,我的宏无法在其中抓取。
Sub Macro3()
'
' Macro3 Macro
'
' Keyboard Shortcut: Ctrl+n
'
Dim ie As Object, continueLoop As Boolean
Dim uRL As String
Dim doc As Object, hDiv As Object, hRef As Object
Dim hA As Object
Dim aChars(1 To 26) As String
Dim x As Long, y As Long, z As Long
Dim wb As Excel.Workbook, ws As Excel.Worksheet
Set wb = Excel.ActiveWorkbook
Set ws = wb.ActiveSheet
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
aChars(1) = "A"
aChars(2) = "B"
aChars(3) = "C"
aChars(4) = "D"
aChars(5) = "E"
aChars(6) = "F"
aChars(7) = "G"
aChars(8) = "H"
aChars(9) = "I"
aChars(10) = "J"
aChars(11) = "K"
aChars(12) = "L"
aChars(13) = "M"
aChars(14) = "N"
aChars(15) = "O"
aChars(16) = "P"
aChars(17) = "Q"
aChars(18) = "R"
aChars(19) = "S"
aChars(20) = "T"
aChars(21) = "U"
aChars(22) = "V"
aChars(23) = "W"
aChars(24) = "X"
aChars(25) = "Y"
aChars(26) = "Z"
y = 1 'Column A in Excel
z = 1 'Row 1 in Excel
x = 1 'Start array
continueLoop = True
ie.navigate "http://www.181.bh/Surname?alpha=A", , , , "Content-Type: application/x-www-form-urlencoded" & vbCrLf
Do While ie.busy: DoEvents: Loop
Do While ie.ReadyState <> 4: DoEvents: Loop
Set doc = ie.document
Do
Set hDiv = doc.GetElementById("NamesIndex")
Set hRef = hDiv.GetElementsByTagName("a")
For Each hA In hRef
y = 1 ' Resets back to column A
ws.Cells(z, y).Value = hA.innertext
DoEvents
z = z + 1
Next hA
If x < 26 Then
x = x + 1
uRL = "http://www.181.bh/Surname?alpha=" + aChars(x)
ie.navigate uRL, , , , "Content-Type: application/x-www-form-urlencoded" & vbCrLf
Do While ie.busy: DoEvents: Loop
Do While ie.ReadyState <> 4: DoEvents: Loop
Set doc = ie.document
Else
continueLoop = False
End If
Loop Until continueLoop = False
ActiveWorkbook.Save
End Sub
【问题讨论】: