使用宏从ssrs站点拉出某些表格

时间:2014-12-11 13:17:06

标签: excel vba excel-vba reporting-services

我已经在网上搜索了两个星期,试图找到一个可以从SSRS网站获取某些表的宏, 我厌倦了很多不同的选择,但一直得到错误的信息。

这是我尝试从中提取数据的网站 http://apps.aspose.com/ssrs-rendering-extensions/Pages/Report.aspx?ItemPath=%2fAdventureWorks+2008+Sample+Reports%2fCompany+Sales+2008

我想要获得的是包含此数据的表格

               2002       2003
  Accessories $93,797     $595,014 
  Bikes       $26,664,534 $35,199,346 
  Clothing    $489,820    $1,024,474 
  Components  $3,611,041  $5,489,741 

这是我的宏

Sub submitFeedback3()

marker = 0
Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
For x = 0 To (IE_count - 1)
    'On Error Resume Next    ' sometimes more web pages are counted than are open
    my_url = objShell.Windows(x).Document.Location
    my_title = objShell.Windows(x).Document.Title

    If my_title Like "Company Sales" & "*" Then 'compare to find if the desired web page is already open
        Set IE = objShell.Windows(x)
        marker = 1
        Exit For
    Else
    End If
Next

If marker = 0 Then
    MsgBox ("A matching webpage was NOT found")
    'Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    IE.Navigate "http://apps.aspose.com/ssrs-rendering-extensions/Pages/Report.aspx?ItemPath=%2fAdventureWorks+2008+Sample+Reports%2fCompany+Sales+2008"
    On Error Resume Next

    Do While IE.Busy: DoEvents: Loop
    Do Until IE.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
Else
    MsgBox ("A matching webpage was found")

End If
    Dim TR_col As Object, Tr As Object
    Dim TD_col As Object, Td As Object
    Dim row As Long, col As Long

    Dim html As Object
    Set html = IE.Document

    html.getElementById ("oReportDiv")

    row = 1
    col = 1

    Set TR_col = html.getElementsByTagName("td")
    For Each Tr In TR_col
       Set TD_col = Tr.getElementsByTagName("div")
       For Each Td In TD_col
           Cells(row, col) = Td.innerText
           col = col + 1
       Next
       col = 1
       row = row + 1
    Next
MsgBox ("Done")
End Sub

提前谢谢

0 个答案:

没有答案