在HTML中查找表名

Question

我已經有了一個代碼，可以從Marketwatch.com網站上的表格中提取共同基金的返回數據，但似乎他們已經改變了頁面和表格的名稱， t似乎弄清楚了和/或提取數據。

一個例子是：marketwatch.com/investing/fund/vfinx

我看來像表名class = "table.table.table--primary.align--right.c6.j-totalReturns"

不工作。我試過的只是「完全返回」，但那也沒有做到。

對此提出建議？謝謝！

編輯： 因此，這裏是多一點我用

Dim oHTML  As Object 
Dim oTable  As Object 
Dim x   As Long 
Dim Y   As Long 
Dim vData  As Variant 

Set oHTML = CreateObject("HTMLFile") 

With CreateObject("WinHTTP.WinHTTPRequest.5.1") 
.Open "GET", "http://www.marketwatch.com/investing/fund/" & 
ActiveCell.Value, False 
.send 
oHTML.body.innerhtml = .responsetext 
End With 

For Each oTable In oHTML.Getelementsbytagname("table") 
If oTable.classname = "fundstable" Then 
    ReDim vData(1 To oTable.Rows.Length, 1 To oTable.Rows(1).Cells.Length) 

     For x = 1 To UBound(vData) 
     For Y = 1 To UBound(vData, 2) 
      vData(x, Y) = oTable.Rows(x - 1).Cells(Y - 1).innertext 
     Next Y 
     Next x 

    With ActiveCell.Offset(1, 0) 
    .Resize(UBound(vData), UBound(vData, 2)).Value = vData 
    End With 
Exit For 
End If 
Next oTable 

Next Z 

所以在紙張上的代碼，我想有幾個代號間隔十行下面開下來，我的宏將往下走，拉每個圖表，然後我有單元格參考被拉的數據。同樣，我唯一的問題是表格不再被命名爲「fundstable」。 再一次，你的方法有效，但我無法讓它乾淨地工作 - 即插入數據開始添加列（並因此移動其他單元格）。想法？

Answer 1

下面的代碼將創建一個新的工作表，把的QueryTable對新表的任何方式，的QueryTable複製到舊錶格（不要將任何東西推到一邊），然後刪除新表格。或者，您可以在需要時使用查詢表和「querytable.refresh」保留新表。這樣做應該更新您將其複製到的工作表。

Sub GetDataFromInternetFirstTimeAndCreateNewSheet() 
    Dim ws As Worksheet 
    Dim actSh As Worksheet 
    Dim numRows As Long, numCols As Long 

    Application.ScreenUpdating = False 

    ' Destroy this sheet if exists 
    On Error Resume Next 
    Application.DisplayAlerts = False 
    ActiveWorkbook.Worksheets("MarketWatch_Query").Delete 
    Application.DisplayAlerts = True 
    On Error GoTo 0 

    Set actSh = ActiveSheet 
    ' Create the new sheet and name it 
    Set ws = Sheets.Add 
    ws.Name = "MarketWatch_Query" 

     With ws.QueryTables.Add(Connection:= _ 
      "URL;http://www.marketwatch.com/investing/index/gdow" _ 
      , Destination:=Range("$A$1")) 
      .FieldNames = True 
      .RowNumbers = False 
      .FillAdjacentFormulas = False 
      .PreserveFormatting = True 
      .RefreshOnFileOpen = False 
      .BackgroundQuery = True 
      .RefreshStyle = xlInsertDeleteCells 
      .SavePassword = False 
      .SaveData = True 
      .AdjustColumnWidth = True 
      .RefreshPeriod = 0 
      .WebSelectionType = xlAllTables 
' You can get specific tables only by changing xlEntirePage to the following 
'   .WebSelectionType = xlSpecifiedTables 'xlAllTables 'xlEntirePage 
'   .WebTables = "1,2" 
      .WebFormatting = xlWebFormattingNone 
      .WebPreFormattedTextToColumns = True 
      .WebConsecutiveDelimitersAsOne = True 
      .WebSingleBlockTextImport = False 
      .WebDisableDateRecognition = False 
      .WebDisableRedirections = False 
      .Refresh BackgroundQuery:=False 
     End With 

    numRows = ws.QueryTables(1).ResultRange.Rows.Count 
    numCols = ws.QueryTables(1).ResultRange.Columns.Count 
    ws.Activate 
    ' Copy the table to any sheet you want to and it will not push anything aside 
    ' However it will overwrite cells so put it somewhere that nothing will be overwritten 
    On Error Resume Next 
    Application.DisplayAlerts = False 
    ws.Range(Cells(1, 1), Cells(numRows, numCols)).Copy Destination:=Sheet1.Cells(10, 1) 
    Application.DisplayAlerts = True 
    On Error GoTo 0 

    ' Then destroy the new sheet 
    On Error Resume Next 
    Application.DisplayAlerts = False 
    ActiveWorkbook.Worksheets("MarketWatch_Query").Delete 
    Application.DisplayAlerts = True 
    On Error GoTo 0 

    Application.ScreenUpdating = True 

End Sub 

Answer 2

這適用於我。發現here：

一旦你的數據，你可以格式化你喜歡

Sub Macro1() 
    ' 
    ' Macro1 Macro 
    ' 

    ' 
     With ActiveSheet.QueryTables.Add(Connection:= _ 
      "URL;http://www.marketwatch.com/investing/index/gdow" _ 
      , Destination:=Range("$A$1")) 
      .FieldNames = True 
      .RowNumbers = False 
      .FillAdjacentFormulas = False 
      .PreserveFormatting = True 
      .RefreshOnFileOpen = False 
      .BackgroundQuery = True 
      .RefreshStyle = xlInsertDeleteCells 
      .SavePassword = False 
      .SaveData = True 
      .AdjustColumnWidth = True 
      .RefreshPeriod = 0 
      .WebSelectionType = xlEntirePage 
' You can get specific tables only by changing xlEntirePage to the following   
'   .WebSelectionType = xlSpecifiedTables 'xlAllTables 'xlEntirePage 
'   .WebTables = "1,2" 
      .WebFormatting = xlWebFormattingNone 
      .WebPreFormattedTextToColumns = True 
      .WebConsecutiveDelimitersAsOne = True 
      .WebSingleBlockTextImport = False 
      .WebDisableDateRecognition = False 
      .WebDisableRedirections = False 
      .Refresh BackgroundQuery:=False 
     End With 

    End Sub