Unable to get data from website by VBA

[PeteExcel]

Hi All,

Please help.

I am using IE9, I am now checking this site, focusing on the dividend's tab (let's call it "original page").
<a href='http://<a href="http://mi.hsbc.com.hk/marketinfo/CorporateNews.aspx?type=ds&lang=eng[/URL" target="_blank">http://mi.hsbc.com.hk/marketinfo/CorporateNews.aspx?type=ds&lang=eng</a>' target="_blank">http://mi.hsbc.com.hk/marketinfo/CorporateNews.aspx?type=ds&lang=eng

At the bottom, there are various pages for you to click, 1,2,3,4,5...so when I click page 3, the URL changes to mi.hsbc.com.hk/marketinfo/CorporateNews.aspx?type=DS&symbol=&lang=eng&pageNumber=3#TOP ; and I am able to see the info in IE perfectly. [pls add back http://]

Click the "1" button will bring me back to page 1; mi.hsbc.com.hk/marketinfo/CorporateNews.aspx?type=DS&symbol=&lang=eng&pageNumber=1#TOP [pls add back http://]
which the content is the same as the "original page" unless the site has updated new info to it.

So, I tried...1#TOP, ...2#TOP... URLs... to try to loop through by VBA, but no luck...However, the VBA script works fine on the "original page" alone.
Here is the script:

Sub CALLXMLHTTPbyNodeCount_manualrun_HSB_v1a()
Dim resultarray() As Long
Dim tempstockcode As Long
Dim macrox, macroy As Long
Dim macromaxx As Long
Dim objcell, objcells As Object
Dim startpage As Long
Dim endpage As Long
Dim loopx As Long

ReDim resultarray(0, 0 To 1)
resultarray(0, 0) = loopx + 1
resultarray(0, 1) = 2

startpage = InputBox("enter the start page")
endpage = InputBox("enter the end page")

resultarray = searchnow_hsb_v4a(resultarray(0, 0), resultarray(0, 1), startpage, endpage)

End Sub

Public Function searchnow_hsb_v4a(x As Long, errorx As Long, searchlowbound As Long, searchupbound As Long) As Variant
Dim xml As Object ' MSXML2.XMLHTTP
Dim html As Object ' MSHTML.HTMLDocument
Dim imgLinks As Object ' MSHTML.IHTMLElementCollection
Dim imgLink As Object ' MSHTML.IHTMLElement
Dim pagesearch As Long
Dim result As String
Dim arrayresult(0, 0 To 1) As Long
Dim resultDIV1 As Object
Dim errorfix1 As Long
Dim checking1 As Boolean
Dim checking2 As Boolean
Dim rowx As Long
Dim tag
Dim tags As Object

rowx = 1
errorfix1 = 0
checking1 = True
checking2 = True

On Error GoTo ErrorHandler 'Turn on ErrorHandler
Set xml = CreateObject("MSXML2.XMLHTTP")

For pagesearch = searchlowbound To searchupbound

With xml

' 'THIS WORKS
' .Open "GET", "http://" & "mi.hsbc.com.hk/marketinfo/CorporateNews.aspx?type=ds&lang=eng", False
' .send

'THIS DOESN'T WORK
.Open "GET", "http://" & "mi.hsbc.com.hk/marketinfo/CorporateNews.aspx?type=DS&symbol=&lang=eng&pageNumber=" & _
pagesearch & "#TOP", False
.send

Do While .readyState <> 4
Application.Wait Now + TimeValue("0:00:02")
Loop

End With

Set html = CreateObject("htmlfile") 'New MSHTML.HTMLDocument
'Suitable for English version only
html.body.innerHTML = xml.responseText

Set imgLinks = html.getElementsByTagName("*") 'loop through ALL tags

Sheets("Sheet1").Select
For Each imgLink In imgLinks
imgcount = imgcount + 1

Cells(rowx, 1).Value = imgLink.innerText

rowx = rowx + 1
Next imgLink

x = x + 1

Next pagesearch

On Error GoTo 0 'Turn off error trapping

Exit Function

ErrorHandler:
Dim errormsg As String

errormsg = "Err.Number: " & Err.Number & Chr(13) & _
"Err.Description: " & Err.Description & Chr(13) & _
"stockcode: " & pagesearch & " time: " & Date & " " & Time
Sheets("error").Cells(errorx, 2).Value = errormsg
errorx = errorx + 1

Resume Next
End Function

It won't work on the 1#TOP, ...2#TOP... URLs, showing "We are sorry that the Service is temporarily not available. Please re-try later." in the xml.responseText.

Is there a way to retrieve the info of the underlying pages?


Regards,

Pete

 

[John_w]

Try it without the "#TOP" in the URLs....

 

[PeteExcel]

Good advice. Thanks John_w.