Question

我需要您对以下代码的帮助。我正在根据日期标准从网站上删除数据。我有代码，直到它从我通过输入框提供的特定日期打开页面，之后它移动到新页面，我有标题下的数据产品，制造商，有条件的NOC，合规日期，药用成分和DIN（s）。我需要将该数据复制到excel中。请问有关如何复制数据的代码吗？下面是我的代码，直到它进入新页面。

Option Explicit
Sub Canada_Sorucing()

Dim IE As Object, obj As Object
Dim mynocFromDate As String

Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.navigate ("https://health-products.canada.ca/noc-ac/index-eng.jsp")
While IE.Readystate <> 4 Or IE.busy: DoEvents: Wend
mynocFromDate = InputBox("enter from date eg.2016-10-01, yyyymmdd")
IE.document.all("nocFromDate").Value = mynocFromDate
IE.document.getElementsByName("action").Item.Click
Do While IE.busy: DoEvents: Loop
worksheets("Sheet1").Range("A:Z").ClearContents

'from here i need to copy data under headings Product(s)    ,Manufacturer   ,NOC with conditions    ,Notice of Compliance date  ,Medicinal ingredient(s)    and DIN(s)

End With
IE.Quit
End Sub

请帮忙。

Answer 1

使用MS Internet Controls和MS HTML Library，我首先要执行以下操作。

Sub Canada_Sorucing()

Dim IE As SHDocVw.InternetExplorer
Dim doc As MSHTML.HTMLDocument
Dim col As MSHTML.IHTMLElementCollection

Dim mynocFromDate As String

Set IE = New InternetExplorer

With IE

    .Visible = True
    .navigate ("https://health-products.canada.ca/noc-ac/index-eng.jsp")

    While IE.readyState <> READYSTATE_COMPLETE Or IE.busy
        DoEvents
    Wend

    mynocFromDate = InputBox("enter from date eg.2016-10-01, yyyymmdd", , "2016-10-01")

    Set doc = IE.document

    With doc
        .getElementById("nocFromDate").Value = mynocFromDate
        .getElementById("action").Click
    End With

    Do While IE.busy Or IE.readyState <> READYSTATE_COMPLETE
        DoEvents
    Loop

    Set doc = IE.document

    '   Here's your start
    MsgBox doc.getElementsByTagName("TR")(1).innerText
    Set col = doc.getElementsByTagName("TR")

End With

IE.Quit

End Sub

使用输入框在给出日期标准后废弃数据

1 个答案: