Excel VBA运行时错误438.对象不支持此属性或方法。当试图复制网站表excel

Question

我想提取一些输入参数从内部网站提取表优秀。一切工作，直到它刷新我的输入网站数据。我得到运行时错误438的部分标记为（For r = 1 To elemCollection.Rows.Length - 1）。我也尝试使用网页查询将数据从网站加载到excel，并且表格未显示在我的Excel电子表格中。 “它给出了以下错误 - 该页面可能无法正常工作，因为您的浏览器不支持脚本或禁用活动脚本。您的浏览器不支持脚本或已配置为不允许脚本。报告查看器Web控制http处理程序有未在应用程序的Web配置文件中注册。“

想知道这是否与权限有关。

VBA代码如下：

Option Explicit 
Sub Macro1() 

    Dim IE As Object, obj As Object 
    Dim StartDate As Object 
    Dim EndDate As Object 
    Dim myState As String 
    Dim r As Integer, c As Integer, t As Integer 
    Dim elemCollection As Object, curHTMLRow As Object 
    Dim wb As Workbook 
    Dim ws As Worksheet 
    Dim objCollection As Object 
    Dim objElement As Object 
    Dim i As Long 

    Set IE = CreateObject("InternetExplorer.Application") 

    IE.Visible = True 

    IE.navigate ("http://internalwebsite_SSRSReport") 

    ' we ensure that the web page downloads completely before we fill the form automatically 
    While IE.ReadyState <> 4: DoEvents: Wend 

    IE.Document.All.Item("ctl31_ctl03_txtValue").InnerText = Format("7/1/2016", "m/d/yyyy") 
    IE.Document.All.Item("ctl31_ctl05_txtValue").InnerText = Format("7/31/2016", "m/d/yyyy") 

    Wait 2 

    IE.Document.getElementsByName("ctl31_ctl04_divDropDown").Item.Click 

    Wait 2 

    ' accessing the button 
    IE.Document.getElementsByName("ctl31_ctl04_ctl00").Item.Click 
    Wait 2 
    ' again ensuring that the web page loads completely before we start scraping data 
    While IE.busy: DoEvents: Wend 

     Wait 2 

    'Clearing any unnecessary or old data in Sheet1 
     ThisWorkbook.Sheets("Sheet1").Activate 
     Range("A1:K500").ClearContents 

     Set elemCollection = IE.Document.getelementbyId("ctl31_ctl09_ReportArea") 

     'error here 
     For r = 1 To elemCollection.Rows.Length - 1 

     Set curHTMLRow = elemCollection.Rows(r) 
     For c = 0 To curHTMLRow.Cells.Length - 1 
      Cells(r + 1, c + 1) = curHTMLRow.Cells(c).InnerText 
     Next 
    Next 

    ' cleaning up memory 
    IE.Quit 
    Set IE = Nothing 

End Sub 
Private Sub Wait(ByVal nSec As Long) 
    nSec = nSec + Timer 
    While nSec > Timer 
     DoEvents 
    Wend 
End Sub 

Answer 1

下面是一些代码，应该能够从SSRS报告抓住从HTML表中的数据并将其解压到Excel中。

基本上，代码将遍历表元素中的所有TR和TD，并将InnerText输出到Excel。如果你正在移动很多的数据，请考虑写入一个数组，然后通过设置一个同样大小的范围对象来一次完成写入操作。

我也清理了代码，主要是删除了未引用，并通过一些语句组合在一起

Option Explicit 

Public Sub GetSSRSData() 
    On Error GoTo errhand: 
    Application.ScreenUpdating = False 
    Dim IE   As Object: Set IE = CreateObject("InternetExplorer.Application") 
    Dim TR_Elements As Object 
    Dim TR   As Object ' Table Row 
    Dim TD_Elements As Object 
    Dim TD   As Object ' Table Data 
    Dim RowNumb  As Integer 
    Dim Columns  As Integer 
    Dim ColumnNumb As Integer 

    With IE 
     .Visible = True 
     .Navigate ("http://internalwebsite_SSRSReport") 

     While .ReadyState <> 4: DoEvents: Wend ' Wait for page load 
     'Fill the form out with dates 
     .Document.All.Item("ctl31_ctl03_txtValue").InnerText = Format("7/1/2016", "m/d/yyyy") 
     .Document.All.Item("ctl31_ctl05_txtValue").InnerText = Format("7/31/2016", "m/d/yyyy") 
     Wait 2 

     'Click the DropDown 
     .Document.getElementsByName("ctl31_ctl04_divDropDown").Item.Click 
     Wait 2 

     ' Click the other button 
     .Document.getElementsByName("ctl31_ctl04_ctl00").Item.Click 
    End With 

    Wait 2 
    While IE.busy: DoEvents: Wend ' Wait for page load 
    Wait 2 

    'Clearing any unnecessary or old data in Sheet1 
    Sheets("Sheet1").Range("A1:K500").ClearContents 
    Set TR_Elements = IE.Document.getelementbyId("ctl31_ctl09_ReportArea").getElementsByTagName("tr") 
    RowNumb = 1 
    ColumnNumb = 1 
    'Tables usually consists of TR (Table Rows), and - 
    'TD (Table Data) 
    For Each TR In TR_Elements 
     Set TD_Elements = TR.getElementsByTagName("td") 
     ColumnNumb = 1 
     For Each TD In TD_Elements 
      'Consider using an array to save the values to memory if there is going 
      'to be a lot of data to be moved over 
      ActiveSheet.Cells(RowNumb, ColumnNumb).Value = TD.InnerText 
      ColumnNumb = ColumnNumb + 1 
     Next 
     RowNumb = RowNumb + 1 
    Next 

    ' cleaning up memory 
    IE.Quit 
    Set IE = Nothing 
    Set TD_Elements = Nothing 
    Set TR_Elements = Nothing 
    Set TD = Nothing 
    Set TR = Nothing 
    Application.ScreenUpdating = True 

errhand: 
    Application.ScreenUpdating = True 
End Sub 

Private Sub Wait(ByVal nSec As Long) 
    nSec = nSec + Timer 
    While nSec > Timer 
     DoEvents 
    Wend 
End Sub