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

Posted 2023-05-07

【中文标题】使用表单从网站屏幕获取数据到 Excel - VBA

【英文标题】：Get data from website screen to Excel with form - VBA

【发布时间】：2014-03-12 13:51:15

【问题描述】：

在 *** 的帮助下，我找到了以下代码；它基本上是打开 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 图标（下载）。

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

【问题讨论】：

这 ***.com/questions/14633691/…> 是否符合您现在需要做的事情？将 csv 导入工作表？

感谢 Jimmy，但由于网站是 php（我假设），因此查询表选项不起作用。在查询表中，URL 在捕获数据方面起着重要作用，但在我的情况下，URL 根本没有改变。

【参考方案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

【讨论】：

+1：这是最好的方法，因为可以针对任何设置一致地抓取表格。

太好了，有没有办法阻止IE弹出（基本上都是在后台做所有的事情），在循环中做有点烦人。

@Vasim 是的，有更好的方法来做到这一点。我会更喜欢使用 xmlhttp 而不是 IE。此外，我们不必一一分配文本框值并等待几秒钟。

@Santosh，谢谢 - 我尝试在 Google 中搜索 xmlhttp，但找不到任何有用的网站，如果您有任何简单的示例，请指导我。

@Vasim 见this link

【参考方案2】：

对不起，最初误解了这个问题。

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

【讨论】：

嗨 Sathish，我的问题中已经有了你的代码。问题是如何从活动工作表中的 Excel 图标文件中获取数据。

OP 已经表示他知道这一点。我相信他的问题基本上在于从点击之外获取 CSV，因为它要求他保存或打开文件。

@BK201 。现在我已经更新了我的代码。在我的系统中运行良好

尽管我已经根据 OP 的需要修改了我的代码，但我仍然没有投票：(