vba 使用VBA在excel中导入Web数据

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/15959008/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 15:22:42  来源:igfitidea点击:

Import web data in excel using VBA

vbaexcel-vbaexcel

提问by Acemi Excelci

I want to import MutualFundsPortfolioValues to Excel. I don't know how to import data from a web site which I need to do is import web data to Excel within 2 different dates of chosen companies ..

我想将 MutualFundsPortfolioValues 导入 Excel。我不知道如何从网站导入数据,我需要做的是在所选公司的 2 个不同日期内将网络数据导入 Excel ..

When I input dates to B3 and B4 cells and click Commandbutton1, Excel might import all data from my web-page to my Excel sheets "result"

当我将日期输入到 B3 和 B4 单元格并单击 Commandbutton1 时,Excel 可能会将所有数据从我的网页导入到我的 Excel 工作表“结果”

For example:

例如:

date 1: 04/03/2013 <<<< " it will be in sheets "input" cell B3
date 2 : 11/04/2013 <<<<< " it will be in sheet "input " cell B4
choosen companies <<<<<< its Range "B7: B17"

I have added a sample excel worksheet and a printscreen of the web page.. Any ideas?

我添加了一个示例 excel 工作表和网页的打印屏幕.. 有什么想法吗?

My web page url :

我的网页网址:

http://www.spk.gov.tr/apps/MutualFundsPortfolioValues/FundsInfosFP.aspx?ctype=E&submenuheader=0

http://www.spk.gov.tr/apps/MutualFundsPortfolioValues/FundsInfosFP.aspx?ctype=E&submenuheader=0

Sample Excel and Sample picture of the data: http://uploading.com/folders/get/b491mfb6/excel-web-query

示例 Excel 和数据的示例图片:http: //uploading.com/folders/get/b491mfb6/excel-web-query

采纳答案by Santosh

Here is the code to import data using IE Automation.

这是使用 IE 自动化导入数据的代码。

Input Parameters(Enter in Sheet1 as per screenshot below)
start date = B3
end date = B4
?irketler = B5 (It allows multiples values which should appear below B5 and so on)

输入参数(按照下面的屏幕截图在 Sheet1 中输入)
开始日期 = B3
结束日期 = B4
?irketler = B5(它允许出现在 B5 下方的倍数值等等)

enter image description here

在此处输入图片说明

ViewSource of pageinput fileds enter image description here

页面输入文件的 ViewSource在此处输入图片说明

How code works :

代码如何工作:

  • The code creates object of Internet Explorer and navigates to site
  • Waits till the page is completely loaded and ready. (IE.readystate)
  • Creates the object html class
  • Enter the values for the input fields from Sheet1 (txtDateBegin,txtDateEnd , lstCompany)
  • Clicks on the submit button
  • Iterates thru each row of table dgFunds and dumps into excel Sheet2
  • 该代码创建 Internet Explorer 对象并导航到 站点
  • 等待页面完全加载并准备就绪。(IE.readystate)
  • 创建对象 html 类
  • 输入 Sheet1 (txtDateBegin,txtDateEnd, lstCompany) 中输入字段的值
  • 点击提交按钮
  • 遍历表 dgFunds 的每一行并转储到 Excel Sheet2

Code:

代码:

   Dim IE As Object
Sub Website()


    Dim Doc As Object, lastRow As Long, tblTR As Object
    Set IE = CreateObject("internetexplorer.application")
    IE.Visible = True

navigate:
    IE.navigate "http://www.spk.gov.tr/apps/MutualFundsPortfolioValues/FundsInfosFP.aspx?ctype=E&submenuheader=0"

    Do While IE.readystate <> 4: DoEvents: Loop

    Set Doc = CreateObject("htmlfile")
    Set Doc = IE.document

    If Doc Is Nothing Then GoTo navigate

    Set txtDtBegin = Doc.getelementbyid("txtDateBegin")
    txtDtBegin.Value = Format(Sheet1.Range("B3").Value, "dd.MM.yyyy")

    Set txtDtEnd = Doc.getelementbyid("txtDateEnd")
    txtDtEnd.Value = Format(Sheet1.Range("B4").Value, "dd.MM.yyyy")


    lastRow = Sheet1.Range("B65000").End(xlUp).row
    If lastRow < 5 Then Exit Sub

    For i = 5 To lastRow

        Set company = Doc.getelementbyid("lstCompany")
        For x = 0 To company.Options.Length - 1
            If company.Options(x).Text = Sheet1.Range("B" & i) Then
                company.selectedIndex = x

                Set btnCompanyAdd = Doc.getelementbyid("btnCompanyAdd")
                btnCompanyAdd.Click
                Set btnCompanyAdd = Nothing

                wait
                Exit For
            End If
        Next
    Next


    wait

    Set btnSubmit = Doc.getelementbyid("btnSubmit")
    btnSubmit.Click

    wait

    Set tbldgFunds = Doc.getelementbyid("dgFunds")
    Set tblTR = tbldgFunds.getelementsbytagname("tr")



    Dim row As Long, col As Long
    row = 1
    col = 1

    On Error Resume Next

    For Each r In tblTR

        If row = 1 Then
            For Each cell In r.getelementsbytagname("th")
                Sheet2.Cells(row, col) = cell.innerText
                col = col + 1
            Next
            row = row + 1
            col = 1
        Else
            For Each cell In r.getelementsbytagname("td")
                Sheet2.Cells(row, col) = cell.innerText
                col = col + 1
            Next
            row = row + 1
            col = 1
        End If
    Next

    IE.Quit
    Set IE = Nothing

    MsgBox "Done"

End Sub

Sub wait()
    Application.wait Now + TimeSerial(0, 0, 10)
    Do While IE.readystate <> 4: DoEvents: Loop
End Sub

Ouput tablein Sheet 2

表 2 中的输出表

enter image description here

在此处输入图片说明

HTH

HTH

回答by Our Man in Bananas

you could read about it by clicking herethen use the macro recorder to record doing it, this will give you some code to work with and if you need more help just ask

您可以通过单击此处阅读它,然后使用宏记录器来记录它,这将为您提供一些代码,如果您需要更多帮助,请询问

here is another question on Stack Overflow: Importing data from web page with diffrent Dates in excel using VBA code

这是关于堆栈溢出的另一个问题:使用 VBA 代码在 excel 中使用不同日期从网页导入数据

basically you're going to add a QueryTable object to the QueryTables collection of the Active worksheet in Excel.

基本上,您将向 Excel 中活动工作表的 QueryTables 集合添加一个 QueryTable 对象。

Here is the MSDN reference on Query Tables: MSDN Library: Excel 2007 Querytables Add method

以下是有关查询表的 MSDN 参考:MSDN Library: Excel 2007 Querytables Add method