VBA：将数据从网站复制到excel

我有一个VBA代码，可以从政府网站的下拉菜单中选择信息，然后提交查询。然后，请求的数据将在另一个IE页面中打开。我正在尝试将这些数据复制到excel中；但是，我不能这样做。 我的代码当前复制包含下拉菜单的第一个IE页面上的文本。政府网页为:

我在互联网上到处寻找解决方案，但似乎什么都不管用

这是我的密码：

Sub GetOsfiFinancialData()

Dim UrlAddress As String
UrlAddress = "http://ws1.osfi-bsif.gc.ca/WebApps/FINDAT/DTIBanks.aspx?T=0&LANG=E"

Dim ie As Object
Set ie = CreateObject("internetexplorer.application")
With ie
    .Silent = True
    .Visible = False
    .navigate UrlAddress
End With

Do Until Not ie.Busy And ie.readyState = 4
    DoEvents
Loop

Application.Wait (Now() + TimeValue("00:00:05"))

'Select Bank
ie.document.getElementById("DTIWebPartManager_gwpDTIBankControl1_DTIBankControl1_institutionTypeCriteria_institutionsDropDownList").Value = Z005

'open window with financial data
Dim objButton
Set objButton = ie.document.getElementById("DTIWebPartManager_gwpDTIBankControl1_DTIBankControl1_submitButton")
objButton.Focus
objButton.Click

'select new pop-up window
marker = 0
Set objshell = CreateObject("Shell.Application")
IE_count = objshell.Windows.Count
For x = 0 To (IE_count - 1)
    On Error Resume Next    ' sometimes more web pages are counted than are open
    my_title = objshell.Windows(x).document.Title

    If my_title Like "Consolidated Monthly Balance Sheet" & "*" Then 'compare to find if the desired web page is already open
        Set ie = objshell.Windows(x)
        marker = 1
        Exit For
    Else
    End If
Next

Do Until Not ie.Busy And ie.readyState = 4
    DoEvents
Loop

Application.Wait (Now() + TimeValue("00:00:05"))

Dim doc As MSHTML.HTMLDocument
Dim tables As MSHTML.IHTMLElementCollection
Dim table As MSHTML.HTMLTable
Dim clipboard As MSForms.DataObject

Set doc = ie.document
Set tables = doc.getElementsByTagName("body")
Set table = tables(0)
Set clipboard = New MSForms.DataObject

'paste in sheets
Dim test
Set test = ActiveWorkbook.Sheets("Test")
clipboard.SetText table.outerHTML
clipboard.PutInClipboard
test.Range("A1").PasteSpecial xlPasteAll
clipboard.Clear

MsgBox ("Task Completed")

End Sub

---

非常感谢你的帮助

我没有时间讨论所有关于从一个浏览器控制另一个浏览器的内容，但我认为你可以理解这一部分，特别是因为你已经在这方面取得了很大的进展。从URL#1中获取URL#2，就像您正在做的那样，但周围有一些更好的数据控件，然后执行此操作

Option Explicit
Sub Web_Table_Option_One()
    Dim xml    As Object
    Dim html   As Object
    Dim objTable As Object
    Dim result As String
    Dim lRow As Long
    Dim lngTable As Long
    Dim lngRow As Long
    Dim lngCol As Long
    Dim ActRw As Long
    Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
    With xml
        .Open "GET", "http://ws1.osfi-bsif.gc.ca/WebApps/Temp/2f40b7ef-d024-4eca-a8a3-fb82153efafaFinancialData.aspx", False
        .send
    End With
    result = xml.responseText
    Set html = CreateObject("htmlfile")
    html.body.innerHTML = result
    Set objTable = html.getElementsByTagName("Table")
    For lngTable = 0 To objTable.Length - 1
        For lngRow = 0 To objTable(lngTable).Rows.Length - 1
            For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
                ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
            Next lngCol
        Next lngRow
        ActRw = ActRw + objTable(lngTable).Rows.Length + 1
    Next lngTable
End Sub

---

您正在将当前测试与

document.Title

一起使用。我发现在所有查找完整标题的窗口中，

与复制粘贴弹出窗口outerHTML结合使用。不需要额外的等待时间

在每个循环的
内
将IE实例重置为新窗口后，可以使用
IE.document.URL
获取新URL。由于您已经加载了数据，我认为您最好直接复制粘贴它


代码：

Option Explicit
Public Sub GetOsfiFinancialData()
    Dim UrlAddress As String, objButton, ie As Object
    UrlAddress = "http://ws1.osfi-bsif.gc.ca/WebApps/FINDAT/DTIBanks.aspx?T=0&LANG=E"
    Set ie = CreateObject("internetexplorer.application")

    With ie
        .Silent = True
        .Visible = False
        .navigate UrlAddress

        While .Busy Or .readyState < 4: DoEvents: Wend

        .document.getElementById("DTIWebPartManager_gwpDTIBankControl1_DTIBankControl1_institutionTypeCriteria_institutionsDropDownList").Value = "Z005"

        Set objButton = .document.getElementById("DTIWebPartManager_gwpDTIBankControl1_DTIBankControl1_submitButton")
        objButton.Focus
        objButton.Click

        Dim objShellWindows As New SHDocVw.ShellWindows, currentWindow As IWebBrowser2

        For Each currentWindow In objShellWindows
            If currentWindow.document.Title = "Consolidated Monthly Balance Sheet - Banks, Trust and Loan" Then
                Set ie = currentWindow
                Exit For
            End If
        Next

        Dim clipboard As Object
        Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        clipboard.SetText ie.document.body.outerHTML
        clipboard.PutInClipboard
        ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial
        .Quit
    End With
End Sub

选项显式
公共子GetOsfiFinancialData（）
Dim UrlAddress作为字符串、objButton、ie作为对象
URL地址=”http://ws1.osfi-bsif.gc.ca/WebApps/FINDAT/DTIBanks.aspx?T=0&LANG=E"
设置ie=CreateObject（“internetexplorer.application”）
与ie
.Silent=True
.Visible=False
.浏览URL地址
当.Busy或.readyState<4:DoEvents:Wend时
.document.getElementById（“DTIWebPartManager\u gwpDTIBankControl1\u DTIBankControl1\u institutionTypeCriteria\u InstitutionDropDownList”）。Value=“Z005”
Set objButton=.document.getElementById（“DTIWebPartManager\u gwpDTIBankControl1\u DTIBankControl1\u submitButton”）
对焦
对象按钮。单击
Dim objShellWindows作为新的SHDocVw.ShellWindows，currentWindow作为IWebBrowser2
对于objShellWindows中的每个currentWindow
如果currentWindow.document.Title=“合并月度资产负债表-银行、信托和贷款”，则
设置ie=currentWindow
退出
如果结束
下一个
将剪贴板变暗为对象
设置剪贴板=GetObject（“新建：{1C3B4210-F441-11CE-B9EA-00AA006B1A69}”）
剪贴板.SetText ie.document.body.outerHTML
剪贴板.PutInClipboard
此工作簿。工作表（“表1”）。单元格（1，1）。粘贴特殊
退出
以
端接头


参考资料（VBE>工具>参考资料）：

Option Explicit
Public Sub GetOsfiFinancialData()
    Dim UrlAddress As String, objButton, ie As Object
    UrlAddress = "http://ws1.osfi-bsif.gc.ca/WebApps/FINDAT/DTIBanks.aspx?T=0&LANG=E"
    Set ie = CreateObject("internetexplorer.application")

    With ie
        .Silent = True
        .Visible = False
        .navigate UrlAddress

        While .Busy Or .readyState < 4: DoEvents: Wend

        .document.getElementById("DTIWebPartManager_gwpDTIBankControl1_DTIBankControl1_institutionTypeCriteria_institutionsDropDownList").Value = "Z005"

        Set objButton = .document.getElementById("DTIWebPartManager_gwpDTIBankControl1_DTIBankControl1_submitButton")
        objButton.Focus
        objButton.Click

        Dim objShellWindows As New SHDocVw.ShellWindows, currentWindow As IWebBrowser2

        For Each currentWindow In objShellWindows
            If currentWindow.document.Title = "Consolidated Monthly Balance Sheet - Banks, Trust and Loan" Then
                Set ie = currentWindow
                Exit For
            End If
        Next

        Dim clipboard As Object
        Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        clipboard.SetText ie.document.body.outerHTML
        clipboard.PutInClipboard
        ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial
        .Quit
    End With
End Sub

Microsoft Internet控件
你有什么错误或不当行为？你想选择哪家银行？您希望得到的数据是什么？@Yuca:当我运行代码时，它复制的是查询页面，而不是弹出窗口中显示的数据输出。@Qharr:现在，我正试图复制所有银行的总计数据。我想复制excel中弹出窗口中显示的输出。什么是Z005？它似乎是一个变量，但我看不到它被分配到任何地方。谢谢，我会试试这个。