使用VBA在Excel中导入Web数据

Question

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

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

例如：

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"

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

我的网页网址：

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

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

Answer 1

您可以read about it by clicking here然后使用宏录制器录制它，这将为您提供一些代码，如果您需要更多帮助，请询问

这是关于Stack Overflow的另一个问题：Importing data from web page with diffrent Dates in excel using VBA code

基本上你要将一个QueryTable对象添加到Excel中的Active工作表的QueryTables集合中。

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

Answer 2

以下是使用IE Automation导入数据的代码。

  

输入参数（按照以下屏幕截图输入Sheet1）
  开始日期= B3
  结束日期= B4
  Şirketler= B5（它允许出现在B5下面的倍数值，依此类推）

页面的ViewSource 输入文件

代码的工作原理：

• 代码创建Internet Explorer的对象并导航到 site
• 等待页面完全加载并准备就绪。 （IE.readystate）
• 创建对象html类
• 输入Sheet1（txtDateBegin，txtDateEnd，lstCompany）输入字段的值
• 点击提交按钮
• 通过表dgFunds的每一行迭代并转储到excel Sheet2

代码：

   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

工作表2中的

输出表

HTH