如何从子URL导入数据?

时间:2017-02-22 03:11:50

标签: vba excel-vba excel

我以为我在周末都想到了这一点,但它实际上并没有像我想象的那样发挥作用。我有一个与我合作的机密企业SharePoint站点。我无法在此处发布链接或任何特定数据,但下面的概念将说明这一点。

我有一个我要从中导入数据的父网址。假设这是父URL。

http://www.sharenet.co.za/v3/q_sharelookup.php

从那里,我想从特定链接导入数据。让我们说这就是链接:'Building&建筑材料公司

我认为最好的方法是使用某种InStr()函数并搜索字符串。然后,如果找到,请单击该链接并打开子URL。当子URL打开时,它看起来像这样:

http://www.sharenet.co.za/v3/sharesfound.php?ssector=2353&exch=JSE&bookmark=Building%20&%20Construction%20Materials&scheme=default

我不知道提前的扇区号是什么,所以我不能使用特定的URL。我需要引用它作为父和子,或者IE1和IE2。我想从子URL中导入所有数据,在本例中,这些数据看起来像这样。

Name    Full Name   Code    Sector
 BUILDMX     BUILDMAX LIMITED       BDM     2353
 KAYDAV      KAYDAV GROUP LTD       KDV     2353
 AFRIMAT     AFRIMAT LTD    AFT     2353
 Trellidor       Trellidor Hldgs Ltd    TRL     2353
 MASONITE    MASONITE (AFRICA) LIMITED      MAS     2353
 DAWN    DISTRIBUTION AND WAREHOUSING NETWORK LIMITED       DAW     2353
 MAZOR       MAZOR GROUP LTD    MZR     2353
 PPC     PPC LIMITED    PPC     2353
 PPCN    PPC Limited NPL    PPCN    2353

为了演示我是如何解决这个问题的,我尝试了下面的脚本。

Sub ListLinks()

'Set a reference to microsoft Internet Controls
Dim IeApp As InternetExplorer
Dim sURL As String
Dim IeDoc As Object
Dim i As Long

Set IeApp = New InternetExplorer

IeApp.Visible = True

sURL = "http://www.sharenet.co.za/v3/q_sharelookup.php"

IeApp.Navigate sURL

Do
Loop Until IeApp.ReadyState = READYSTATE_COMPLETE
Set IeDoc = IeApp.Document

For i = 0 To IeDoc.Links.Length - 1
    Cells(i + 1, 1).Value = IeDoc.Links(i).href
Next i

Set IeApp = Nothing
End Sub

我认为它可以正常工作,列出所有网址,然后遍历每个网址以导入数据,但我的SharePoint网站上的问题是href似乎与超链接的名称没有任何关联。

enter image description here

在上面的图片中,您可以看到'Building& TD元素中的建筑材料。如果我可以在第一个浏览器中引用它,并单击正确的链接以打开第二个浏览器,然后引用第二个浏览器并从中抓取所有TD元素,一切都应该正常工作。这里有人知道怎么做吗?

1 个答案:

答案 0 :(得分:2)

很好地尝试代码,让它非常接近 - 需要一些修复的一个方面是当你尝试获取项目列表并循环它时。你对它的工作方式有了正确的认识,但是HTML元素的语法略有不同,所以看起来只需要更多使用HTML对象的经验...参见下面的示例代码:

Public Sub sampleCode()
Dim URL As String
Dim XMLHTTP As MSXML2.XMLHTTP60
Dim HTMLDoc_Main As HTMLDocument
Dim HTMLDoc_Secondary As HTMLDocument
Dim targetTable As HTMLObjectElement
Dim links As IHTMLElementCollection
Dim linkCounter As Long

Dim searchText As String

URL = "http://www.sharenet.co.za/v3/q_sharelookup.php"
searchText = "Building & Construction Materials"

Set XMLHTTP = New MSXML2.XMLHTTP60
Set HTMLDoc_Main = New HTMLDocument
With XMLHTTP
    .Open "GET", URL, False
    .send
    While .readyState <> 4: Wend
    HTMLDoc_Main.body.innerHTML = .responseText
End With

Set targetTable = HTMLDoc_Main.getElementsByClassName("dataTable")(0)
Set links = targetTable.getElementsByTagName("a")
For linkCounter = 0 To links.Length - 1
    With links(linkCounter)
        If InStr(1, .innerText, searchText) > 0 Then
            Set XMLHTTP = New MSXML2.XMLHTTP60
            Set HTMLDoc_Secondary = New HTMLDocument
            XMLHTTP.Open "GET", .href, False
            XMLHTTP.send
            While XMLHTTP.readyState <> 4: Wend
            HTMLDoc_Secondary.body.innerHTML = XMLHTTP.responseText
            'Parse HTMLDoc_Secondary
        End If
    End With
Next

Set XMLHTTP = Nothing
Set HTMLDoc_Main = Nothing
Set HTMLDoc_Secondary = Nothing
End Sub

情侣笔记 - 1)我使用XMLHTTPRequest而不是IE,因为它更快,所以2)你需要添加&#39; Microsoft HTML Object Library&#39;和&#39; Microsoft XML,v6.0&#39;对你的参考资料和3)我可以看到你输出到原始代码中的范围 - 如果可能的话,应该避免这种情况。填充数组,然后将其全部内容一次性转储到目标工作表中以节省时间......

希望这有帮助, TheSilkCode