使用表单-VBA将数据从网站屏幕获取到Excel_Vba_Excel

使用表单-VBA将数据从网站屏幕获取到Excel

vba excel

使用表单-VBA将数据从网站屏幕获取到Excel,vba,excel,Vba,Excel,在Stackoverflow的帮助下，我获得了以下代码：；它基本上打开IE，导航到url，填写表单并提交 Sub getdata() Application.ScreenUpdating = False Set IE = CreateObject("InternetExplorer.Application") IE.Visible = True IE.Navigate "http://www.bseindia.com/markets/equity/EQRepor

在Stackoverflow的帮助下，我获得了以下代码：；它基本上打开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

Sub-getdata（）
Application.ScreenUpdating=False
设置IE=CreateObject（“InternetExplorer.Application”）
可见=真实
即“导航”http://www.bseindia.com/markets/equity/EQReports/BulknBlockDeals.aspx?expandable=7"
Application.StatusBar=“提交”
“等一下，我正在装货。。。
趁我忙
多芬特
温德
' **********************************************************************
延迟5
IE.document.getElementbyid（“ctl00\u内容占位符1\u chkAllMarket”）。单击
延迟5
IE.document.getElementbyid（“ctl00\u ContentPlaceHolder1\u txtDate”）.Value=“01/01/2014”
延迟5
IE.document.getElementbyid（“ctl00\u ContentPlaceHolder1\u txtToDate”）.Value=“12/01/2014”
延迟5
IE.document.getElementbyid（“ctl00\U内容占位符1\U BTNSUPmit”）。单击
延迟5
''IE.document.getElementbyid（“ctl00\u内容占位符1\u btnDownload”）。单击
''（由于单击给出了请求保存、打开csv文件的选项，因此进行了注释）
'**********************************************************************
Application.StatusBar=“表单已提交”
“IE.Quit”工作后将取消注释行
“Set IE=Nothing”将在工作后取消注释行
Application.ScreenUpdating=True
端接头
专用子延迟（秒长）
Dim endTime作为日期
endTime=DateAdd（“s”，秒，Now（））
立即执行（）


问题是：
提交表单后，数据将在屏幕上填充，并且会出现一个Excel图标（下载），其中包含csv中的相同数据
如何在我的活动工作表中获取这些数据（任何人都可以）。
很抱歉最初误解了这个问题。
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

现在我得到了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

Sub-getdata（）
Application.ScreenUpdating=False
设置ie=CreateObject（“InternetExplorer.Application”）
可见=真实
即“导航”http://www.bseindia.com/markets/equity/EQReports/BulknBlockDeals.aspx?expandable=7"
Application.StatusBar=“提交”
“等一下，我正在装货。。。
趁我忙
多芬特
温德
' **********************************************************************
延迟5
ie.document.getelementbyid（“ctl00\u内容占位符1\u chkAllMarket”）。单击
延迟5
ie.document.getelementbyid（“ctl00\u ContentPlaceHolder1\u txtDate”）.Value=“01/01/2014”
延迟5
ie.document.getelementbyid（“ctl00\u ContentPlaceHolder1\u txtToDate”）.Value=“12/01/2014”
延迟5
ie.document.getelementbyid（“ctl00\U内容占位符1\U BTNSUPmit”）。单击
延迟5
'ie.document.getelementbyid（“ctl00\u内容占位符1\u btnDownload”）。单击
Set doc=ie.document
对于doc.all.tags（“表”）中的每个d
如果InStr（d.innertext，“客户名称”）>0，则
与d
对于x=0到.Rows.Length-1
对于y=0到.Rows（x）.Cells.Length-1
工作表（1）.单元格（x+1，y+1）.值=.Rows（x）.单元格（y）.innertext
下一个y
下一个x
以
如果结束
下一个d
Application.ScreenUpdating=True
端接头
专用子延迟（秒长）
Dim endTime作为日期
endTime=DateAdd（“s”，秒，Now（））
立即执行（）
很抱歉最初误解了这个问题。
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

现在我得到了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

Sub-getdata（）
Application.ScreenUpdating=False
设置ie=CreateObject（“InternetExplorer.Application”）
可见=真实
即“导航”http://www.bseindia.com/markets/equity/EQReports/BulknBlockDeals.aspx?expandable=7"
Application.StatusBar=“提交”
“等一下，我正在装货。。。
趁我忙
多芬特
温德
' **********************************************************************
延迟5
ie.document.getelementbyid（“ctl00\u内容占位符1\u chkAllMarket”）。单击
延迟5
ie.document.getelementbyid（“ctl00\u ContentPlaceHolder1\u txtDate”）.Value=“01/01/2014”
延迟5
ie.document.getelementbyid（“ctl00\u ContentPlaceHolder1\u txtToDate”）.Value=“12/01/2014”
延迟5
ie.document.getelementbyid（“ctl00\U内容占位符1\U BTNSUPmit”）。单击
延迟5
'ie.document.getelementbyid（“ctl00\u内容占位符1\u btnDownload”）。单击
Set doc=ie.document
对于doc.all.tags（“表”）中的每个d
如果InStr（d.innertext，“客户名称”）>0，则
与d
对于x=0到.Rows.Length-1
对于y=0到.Rows（x）.Cells.Length-1
工作表（1）.单元格（x+1，y+1）.值=.Rows（x）.单元格（y）.innertext
下一个y
下一个x
以
如果结束
下一个d
Application.ScreenUpdating=True
端接头
专用子延迟（秒长）
Dim endTime作为日期
endTime=DateAdd（“s”，秒，Now（））
立即执行（）
试试这个
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

Sub-getdata（）
Application.ScreenUpdating=False
设置IE=CreateObject（“InternetExplorer.Application”）
可见=真实
即“导航”http://www.bseindia.com/markets/equity/EQReports/BulknBlockDeals.aspx?expandable=7"
Application.StatusBar=“提交”
“等一下，我正在装货。。。
趁我忙
多芬特
温德
' **********************************************************************
延迟5
IE.document.getelementbyid（“ctl00\u ContentPla