使用表格 – VBA从网站屏幕获取数据到Excel

在Stackoverflow的帮助下，我find了下面的代码。 它基本上打开IE，导航到url，填写表格并提交。

Sub getdata() Application.ScreenUpdating = False Set IE = CreateObject("InternetExplorer.Application") IE.Visible = True IE.Navigate "http://www.bseindia.com/markets/equity/EQReports/BulknBlockDeals.aspx?expandable=7" Application.StatusBar = "Submitting" ' Wait while IE loading... While IE.Busy DoEvents Wend ' ********************************************************************** delay 5 IE.document.getElementbyid("ctl00_ContentPlaceHolder1_chkAllMarket").Click delay 5 IE.document.getElementbyid("ctl00_ContentPlaceHolder1_txtDate").Value = "01/01/2014" delay 5 IE.document.getElementbyid("ctl00_ContentPlaceHolder1_txtToDate").Value = "12/01/2014" delay 5 IE.document.getElementbyid("ctl00_ContentPlaceHolder1_btnSubmit").Click delay 5 '''IE.document.getElementbyid("ctl00_ContentPlaceHolder1_btnDownload").Click '''(Commented as the click gives the option asking to save, open the csv file) '********************************************************************** Application.StatusBar = "Form Submitted" 'IE.Quit 'will uncomment line once working 'Set IE = Nothing 'will uncomment line once working Application.ScreenUpdating = True End Sub Private Sub delay(seconds As Long) Dim endTime As Date endTime = DateAdd("s", seconds, Now()) Do While Now() < endTime DoEvents Loop End Sub 

问题：

一旦表单被提交，数据就被填充在屏幕上，并且在csv中有相同数据的Excel图标（下载）。

我如何在活动工作表中获取这些数据（任何方式都可以）。

Answer 1

尝试这个

 Sub getdata() Application.ScreenUpdating = False Set IE = CreateObject("InternetExplorer.Application") IE.Visible = True IE.Navigate "http://www.bseindia.com/markets/equity/EQReports/BulknBlockDeals.aspx?expandable=7" Application.StatusBar = "Submitting" ' Wait while IE loading... While IE.Busy DoEvents Wend ' ********************************************************************** delay 5 IE.document.getelementbyid("ctl00_ContentPlaceHolder1_chkAllMarket").Click delay 5 IE.document.getelementbyid("ctl00_ContentPlaceHolder1_txtDate").Value = "01/01/2014" delay 5 IE.document.getelementbyid("ctl00_ContentPlaceHolder1_txtToDate").Value = "12/01/2014" delay 5 IE.document.getelementbyid("ctl00_ContentPlaceHolder1_btnSubmit").Click delay 5 '********************************************************************** Application.StatusBar = "Form Submitted" Dim tbl As Object, tr As Object, trCol As Object, td As Object, tdCol As Object Dim row As Long Dim col As Long row = 1 col = 1 Set tbl = IE.document.getelementbyid("ctl00_ContentPlaceHolder1_divData1").getElementsbytagname("Table")(0) Set trCol = tbl.getElementsbytagname("TR") For Each tr In trCol Set tdCol = tr.getElementsbytagname("TD") For Each td In tdCol Cells(row, col) = td.innertext col = col + 1 Next col = 1 row = row + 1 Next IE.Quit 'will uncomment line once working Set IE = Nothing 'will uncomment line once working Application.ScreenUpdating = True End Sub Private Sub delay(seconds As Long) Dim endTime As Date endTime = DateAdd("s", seconds, Now()) Do While Now() < endTime DoEvents Loop End Sub 

Answer 2

抱歉误解了最初的问题。

现在我得到了OP想要的东西。

在这里，我不会告诉如何点击下载窗口中的打开button。

但结果会导出所需的数据到Excel中（这是OP想要它看起来）

testing和我的系统工作正常。

 Sub getdata() Application.ScreenUpdating = False Set ie = CreateObject("InternetExplorer.Application") ie.Visible = True ie.Navigate "http://www.bseindia.com/markets/equity/EQReports/BulknBlockDeals.aspx?expandable=7" Application.StatusBar = "Submitting" ' Wait while IE loading... While ie.Busy DoEvents Wend ' ********************************************************************** delay 5 ie.document.getelementbyid("ctl00_ContentPlaceHolder1_chkAllMarket").Click delay 5 ie.document.getelementbyid("ctl00_ContentPlaceHolder1_txtDate").Value = "01/01/2014" delay 5 ie.document.getelementbyid("ctl00_ContentPlaceHolder1_txtToDate").Value = "12/01/2014" delay 5 ie.document.getelementbyid("ctl00_ContentPlaceHolder1_btnSubmit").Click delay 5 ' ie.document.getelementbyid("ctl00_ContentPlaceHolder1_btnDownload").Click Set doc = ie.document For Each d In doc.all.tags("table") If InStr(d.innertext, "Client Name") > 0 Then With d For x = 0 To .Rows.Length - 1 For y = 0 To .Rows(x).Cells.Length - 1 Sheets(1).Cells(x + 1, y + 1).Value = .Rows(x).Cells(y).innertext Next y Next x End With End If Next d Application.ScreenUpdating = True End Sub Private Sub delay(seconds As Long) Dim endTime As Date endTime = DateAdd("s", seconds, Now()) Do While Now() < endTime DoEvents Loop End Sub