使用 VBA 将数据从 Web 复制到 Excel

Question

I have a webpage and need my code to copy the entire data from the page and copy it into the excel sheet, which is not happening right now. My excel sheet is coming to be completely blank. I think the ^a feature is not working on the IE to select the data and then copy it.

Any help is much appreciated. Below is the code I am using.

Sub Webdata()

    Dim assetname As String, country As String, area As String, region As String, pth As String, folname As Variant, assetname1 As String

    Website = "http://website.com/"
    Set myIE = CreateObject("InternetExplorer.Application")
    myIE.Navigate source
    myIE.Visible = True
    Application.Wait Now + TimeSerial(0, 0, 10)
    SendKeys "^a"
    Application.Wait Now + TimeSerial(0, 0, 2)
    SendKeys "^c"
    Application.Wait Now + TimeSerial(0, 0, 2)
    Sheets.Add
    ActiveSheet.Name = "Webdata"
    ActiveSheet.Paste
    Application.Wait Now + TimeSerial(0, 0, 2)

    Range("A1").Select
    Cells.Find(What:="Api Number", After:=ActiveCell, LookIn:= _
               xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
               xlNext, MatchCase:=False, SearchFormat:=False).Activate

    ActiveCell.Offset(1, 0).Select
    Selection.Copy
    Sheets("Sheet1").Activate
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                           :=False, Transpose:=False
    Application.CutCopyMode = False
    myIE.Quit

    Set myIE = Nothing
    Err.Clear
    Sheets("Webdata").Select
    ActiveSheet.Delete

End Sub

Answer 1

That table is a mess so rather than spending time perfecting how to write out the table to the sheet in the way I normally would ie looping rows of tables and table cells within rows, I will stick with your idea of copying the table but use the clipboard, with .SetText , rather than SendKeys . The table of interest is within nested frames so you have to negotiate those first.

Set hTable = .frames(2).document.getElementsByTagName("table")(0)

Code:

Option Explicit
Public Sub GetInfo()
    Dim IE As New InternetExplorer, html As HTMLDocument, hTable As HTMLTable, clipboard As Object
    Application.ScreenUpdating = False
    With IE
        .Visible = True
        .navigate "http://pipeline.wyo.gov/Wellapi.cfm?oops=IDxxxxx&nAPINO=xxxxxx" '<==Input your personal URL here 
        While .Busy Or .readyState < 4: DoEvents: Wend
        Set html = .document
        With html
            Set hTable = .frames(2).document.getElementsByTagName("table")(0)
            Set clipboard = New MSForms.DataObject
            clipboard.SetText hTable.outerHTML
            clipboard.PutInClipboard
            ActiveSheet.Cells(1, 1).PasteSpecial
        End With
        .Quit
    End With
    Application.ScreenUpdating = True
End Sub

---

References:

VBE> Tools > References:

1. Microsoft Forms 2.0 Object Library
2. HTML Object Library
3. Internet Explorer Controls