我以为我在周末都想到了这一点,但它实际上并没有像我想象的那样发挥作用。我有一个与我合作的机密企业SharePoint站点。我无法在此处发布链接或任何特定数据,但下面的概念将说明这一点。
我有一个我要从中导入数据的父网址。假设这是父URL。
http://www.sharenet.co.za/v3/q_sharelookup.php
从那里,我想从特定链接导入数据。让我们说这就是链接:'Building&建筑材料公司
我认为最好的方法是使用某种InStr()函数并搜索字符串。然后,如果找到,请单击该链接并打开子URL。当子URL打开时,它看起来像这样:
我不知道提前的扇区号是什么,所以我不能使用特定的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似乎与超链接的名称没有任何关联。
在上面的图片中,您可以看到'Building& TD元素中的建筑材料。如果我可以在第一个浏览器中引用它,并单击正确的链接以打开第二个浏览器,然后引用第二个浏览器并从中抓取所有TD元素,一切都应该正常工作。这里有人知道怎么做吗?
答案 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