Excel VBA - 実行時エラー438.オブジェクトがこのプロパティまたはメソッドをサポートしていません。

Question

私はいくつかの入力パラメータを与えることでExcelに内部のWebサイトからテーブルを抽出しようとしています。入力したウェブサイトのデータを更新するまではすべて動作します。実行時エラー438を取得する部分には（For r = 1 To elemCollection.Rows.Length - 1）とマークされています。私はまた、Webクエリを使用してExcelのWebサイトからデータを読み込もうとしましたが、テーブルがExcelスプレッドシートに表示されませんでした。 「このページは、ブラウザがスクリプトをサポートしていないか、アクティブスクリプトが無効になっているため、正しく機能しない可能性があります。アプリケーションの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