在Stackoverflow的帮助下,我达到了以下代码;它基本上打开IE,导航到网址,填写表格并提交。
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图标(下载),其中包含相同的数据。
如何在我的活动工作表中获取此数据(任何方式都可以)。
答案 0 :(得分:4)
试试这个
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
答案 1 :(得分:0)
抱歉最初误解了这个问题。
现在我得到了OP想要的东西。
这里我不打算告诉如何点击下载窗口中的打开按钮。
但是结果会将所需数据导出到excel(这就是OP想要的样子)
在我的系统中经过测试和正常工作。
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