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

Ln 85 Col 15 中的错误是 因为您无法结束,如果在 For ...只需将其移到外面即可...并且应该修复错误

最新更新