Я хотел собрать данные (имя) из www.181.bh . Этот сайт использует метод POST и не позволяет изменять поиск с помощью URL.
Я использую Excel VB Macro для сбора данных с помощью следующего кода. Мне нужно собирать имена от 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