VBA提取数据:不使用Next时出现编译错误

时间:2018-08-08 12:16:41

标签: excel vba excel-vba

我一直在关注在线教程(https://www.wiseowl.co.uk/blog/s393/scrape-website-html.htm)。我遇到一些问题,不确定如何解决。基本上,我试图从网站上收集数据。

任何提示和想法如何解决该问题?

预先感谢。我输入了以下代码:

Enum READYSTATE
READYSTATE_UNINITIALIZED = 0
READYSTATE_LOADING = 1
READYSTATE_LOADED = 2
READYSTATE_INTERACTIVE = 3
READYSTATE_COMPLETE = 4
End Enum
Option Explicit

Sub ImportStackOverflowData()


'to refer to the running copy of Internet Explorer
Dim ie As InternetExplorer

'to refer to the HTML document returned
Dim html As HTMLDocument

'open Internet Explorer in memory, and go to website
Set ie = New InternetExplorer
ie.Visible = False
ie.navigate "https://ted.europa.eu/udl?uri=TED:NOTICE:310761-2018:TEXT:EN:HTML&src=0"

'Wait until IE is done loading page
Do While ie.READYSTATE <> READYSTATE_COMPLETE
    Application.StatusBar = "Trying to go to StackOverflow ..."
    DoEvents
Loop

'show text of HTML document returned
Set html = ie.document

MsgBox html.DocumentElement.innerHTML

'close down IE and reset status bar
Set ie = Nothing
Application.StatusBar = ""

'clear old data out and put titles in
Cells.Clear

'put heading across the top of row 3
Range("A3").Value = "Company ID"

Dim CompanyList As IHTMLElement
Dim Companies As IHTMLElementCollection
Dim Company As IHTMLElement
Dim RowNumber As Long
Dim CompanyId As String
Dim CompanyFields As IHTMLElementCollection
Dim CompanyField As IHTMLElement

Dim votes As String
Dim views As String

Dim CompanmyFieldLinks As IHTMLElementCollection

Set CompanyList = html.getElementById("fullDocument")
Set Companies = CompanyList.Children
RowNumber = 4

For Each Company In Companies

  'if this is the tag containing the company details, process it
  If Company.className = "txtmark" Then
      'first get and store the company id in first column
      CompanyId = Replace(Company.ID, "timark", "")
      Cells(RowNumber, 1).Value = CLng(CompanyId)

     'get a list of all of the parts of this company,
     'and loop over them
     Set CompanyFields = Company.all

     For Each CompanyField In CompanyFields  
        'go on to next row of worksheet
        RowNumber = RowNumber + 1
     Next    
  End If

  Set html = Nothing

  Application.StatusBar = ""
  MsgBox "Done!"
End Sub

1 个答案:

答案 0 :(得分:-1)

如果在For ...中,Ln 85 Col 15中的错误是无法结束的,只需将其移到For ...之外,并且错误应该得到解决