使用VBA导入Excel数据 [英] Import web data in excel using VBA

问题描述

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

当我输入日期到B3和B4单元格，然后单击Commandbutton1，Excel可能会将所有数据从我的网页导入到我的Excel表结果

例如：

 日期1：04/03/2013<<<< 它将在表格输入单元格B3 
日期2：11/04/2013 
 
将在表格输入单元格B4 
选择公司<<<<<<它的范围B7：B17
  

我添加了一个示例excel工作表和网页的打印屏幕
任何想法？

我的网页网址：

等待页面完全加载并准备就绪。 （IE.readystate）

创建对象html类

从Sheet1（txtDateBegin，txtDateEnd，lstCompany）输入输入字段的值

点击提交按钮

通过表格dgFunds的每一行迭代并转储到excel Sheet2

代码

  Dim IE As Object 
子网站（）
 
 
 Dim Doc As Object，lastRow As Long，tblTR As Object 
设置IE = CreateObject（internetexplorer.application）
 IE。 Visible = True 
 
导航：
 IE.navigatehttp://www.spk.gov.tr/apps/MutualFundsPortfolioValues/FundsInfosFP.aspx?ctype=E&submenuheader=0
 
尽管IE.readystate<> 4：DoEvents：Loop 
 
设置Doc = CreateObject（htmlfile）
设置Doc = IE.document 
 
如果Doc是没有，然后GoTo导航
 
设置txtDtBegin = Doc.getelementbyid（txtDateBegin）
 txtDtBegin.Value =格式（Sheet1.Range（B3）。值，dd.MM.yyyy）
 
设置txtDtEnd = Doc.getelementbyid（txtDateEnd）
 txtDtEnd.Value =格式（Sheet1.Range（B4）。值，dd.MM.yyyy）
 
 
 lastRow = Sheet1.Range（B65000）。End（xlUp）.row 
如果lastRow< 5然后退出Sub 
 
对于i = 5 To lastRow 
 
设置公司= Doc.getelementbyid（lstCompany）
对于x = 0到company.Options。长度 -  1 
如果company.Options（x）.Text = Sheet1.Range（B& i）然后
 company.selectedIndex = x 
 
设置btnCompanyAdd = Doc .getelementbyid（btnCompanyAdd）
 btnCompanyAdd.Click 
设置btnCompanyAdd =没有
 
等待
退出
结束如果
下一个
下一个
 
 
等待
 
设置btnSubmit = Doc.getelementbyid（btnSubmit）
 btnSubmit.Click 
 
等待
 
设置tbldgFunds = Doc.getelementbyid（dgFunds）
设置tblTR = tbldgFunds.getelementsbytagname（tr）
 
 
 
 Dim row As Long，col As Long 
 row = 1 
 col = 1 
 
 On Error Resume Next 
 
对于每个r在tblT R 
 
如果row = 1然后
对于每个单元格在r.getelementsbytagname（th）
 Sheet2.Cells（row，col）= cell.innerText 
 col = col + 1 
下一个
 row = row + 1 
 col = 1 
 Else 
对于每个单元格在r.getelementsbytagname（td）
 Sheet2.Cells（row，col）= cell.innerText 
 col = col + 1 
下一个
 row = row + 1 
 col = 1 
 End If 
下一个
 
 IE.Quit 
设置IE =没有
 
 MsgBoxDone
 
 End Sub 
 
 Sub wait（）
 Application.wait Now + TimeSerial（0，0，10）
尽管IE.readystate<> 4：DoEvents：Loop 
 End Sub 
  

Ouput表表格2

HTH

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 ..

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"

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?

My web page url :

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

解决方案

Here is the code to import data using IE Automation.

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)

ViewSource of page input fileds

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

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 table in Sheet 2

HTH

这篇关于使用VBA导入Excel数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！