HTMLの表を取得するには？

解決

コテツ 2003-11-03 04:58:27 No: 109645

WebBrowser1に、今日のテレビ欄
（１１月２日の場合： http://tv.yahoo.co.jp/vhf/tokyo/2003110224.html?g=1）を表示し、Command1をクリックすると、RichTextBox1に、NHK総合の１日分の番組を表示しようと思っているのですが、全局の番組を表示は出来るのですが、NHK総合の１日分のみを表示する場合が、わかりません。
どうすればいいのでしょうか？

Private Sub Form_Load()
WebBrowser1.Navigate "http://tv.yahoo.co.jp/vhf/tokyo/2003110224.html?g=1"
End Sub

Private Sub Command1_Click()
On Error GoTo Err_Bangumi

    Dim objTables As Object
    Dim objTable  As Object
    Dim Temp_Bangumi1 As String
    Dim Temp_Bangumi2 As String
    Dim i As Integer

Set objTables = WebBrowser1.Document.getElementsByTagName("TABLE")

    If objTables.length > 0 Then
        For i = 7 To 500 Step 1
            Temp_Bangumi1 = objTables(i).rows(0).cells(1).innerTEXT
            Temp_Bangumi2 = Temp_Bangumi2 & Temp_Bangumi1 + Chr(13) + Chr(10)
        Next i
    End If

Err_Bangumi:
RichTextBox1.Text = Temp_Bangumi2
End Sub

red-fish 2003-11-05 06:30:30 No: 109646

Index6がルートTableだからここからCellをたどって
offsetLeftで分類するとかはどうでしょう？
(どうせ決め打ちだし……。
XMLで提供してくれるとこがドコかにあったらいいのにね)

Private Sub Command2_Click()
  Const IDX_TV_PROGRAM_ROOT_TABLE% = 6
  Const LEFT_1CH_NHK& = 19

  Dim objTable As Object 'MSHTML.HTMLTable
  Dim objCell As Object  'MSHTML.HTMLTableCell
  Dim Temp_Bangumi As String

  Set objTable = WebBrowser1.Document.getElementsByTagName( _
                 "TABLE")(IDX_TV_PROGRAM_ROOT_TABLE)
  For Each objCell In objTable.cells
    If objCell.offsetLeft = LEFT_1CH_NHK& Then
      Temp_Bangumi = Temp_Bangumi & objCell.innerText & vbNewLine
    End If
  Next

RichTextBox1.Text = Temp_Bangumi
End Sub

コテツ 2003-11-05 08:47:15 No: 109647

red-fishさん、思い通りの事が出来ました。
ありがとうございます。

もず 2003-11-05 19:16:28 No: 109648

red-fishさん、私も参考になりました。
でも、このプログラムだと、NHK総合の１日分ですよね。
私の場合は、全局の１日分を表示したいのですが、どのようにしたら、いいのでしょうか？

＜表示例＞
---------------------------------------------
NHK総合
05：00 ****
・・・・
〜
---------------------------------------------
NHK教育
06：00 ****
・・・・
〜
---------------------------------------------
・・・・

たろう 2003-11-05 21:34:45 No: 109649

red-fishさんのコードを基に、作成してみました。
もずさん、こんな感じでどうでしょうか？

Private Sub Command3_Click()
    Const IDX_TV_PROGRAM_ROOT_TABLE% = 6
    Dim CH(6) As Integer
    Dim i As Integer

    CH(0) = 19
    CH(1) = 251
    CH(2) = 470
    CH(3) = 704
    CH(4) = 938
    CH(5) = 1145
    CH(6) = 1370

    Dim objTable As Object 'MSHTML.HTMLTable
    Dim objCell As Object  'MSHTML.HTMLTableCell
    Dim Temp_Bangumi1 As String

    Set objTable = WebBrowser1.Document.getElementsByTagName("TABLE")(IDX_TV_PROGRAM_ROOT_TABLE)

    Temp_Bangumi1 = Temp_Bangumi1 & "-------------------------------------------" & vbNewLine

    For i = 0 To 6
        For Each objCell In objTable.cells
            If objCell.offsetLeft = CH(i) Then
                Temp_Bangumi1 = Temp_Bangumi1 & objCell.innerText & vbNewLine
            End If
        Next

        Temp_Bangumi1 = Temp_Bangumi1 & "-------------------------------------------" & vbNewLine
   Next i

RichTextBox1.Text = Temp_Bangumi1
End Sub

もず 2003-11-05 23:27:26 No: 109650

たろうさん、NHK総合のみしか出力されませんよ！

たろう 2003-11-06 05:53:08 No: 109651

もずさん、のとおりです。
CH(1)〜CH(6)の値を、下記の値に変更してください。
これでいくはずです。

    CH(1) = 103
    CH(2) = 187
    CH(3) = 289
    CH(4) = 373
    CH(5) = 457
    CH(6) = 559

red-fish 2003-11-06 06:56:19 No: 109652

> たろうさん、NHK総合のみしか出力されませんよ！

それは、そこが田舎の旅館だからでは？

というのは冗談で、IEのVersionやFontSizeなどに
おもいっきり依存してしまうでしょう。今回はList
を1つ増やし、そこにチャンネルが列挙されるように
してみました。これで環境依存はちょっとだけ緩和
されるでしょう。

Private m_colChannel As New Collection 'チャンネルCollection

Private Sub Command4_Click()
  Const IDX_TV_PROGRAM_ROOT_TABLE% = 6

  Dim objTable As Object 'MSHTML.HTMLTable
  Dim objCell As Object  'MSHTML.HTMLTableCell

  Dim blnChannelScanFlag As Boolean 'チャンネルをスキャン中Flag
  Dim strSingleLine As String '複数行になるのを1行にしたWorkString
  Dim blnNumeric As Boolean   '時間セルの場合にTrue
  Dim blnEmpty As Boolean     '空白セルの場合にTrue

  List1.Clear
  RichTextBox1.Text = vbNullString

  Set objTable = WebBrowser1.Document.getElementsByTagName( _
                 "TABLE")(IDX_TV_PROGRAM_ROOT_TABLE)

  blnChannelScanFlag = True
  For Each objCell In objTable.cells
    strSingleLine = Replace$(objCell.innerText, vbNewLine, " ")
    blnNumeric = isNumeric(strSingleLine)
    blnEmpty = (Len(Trim$(strSingleLine)) = 0)
    If blnChannelScanFlag Then
      'チャンネルをスキャン中...
      If blnNumeric Then
        '時間のセルが登場したのでチャンネルのスキャンは完了!
        blnChannelScanFlag = False
      ElseIf Not blnEmpty Then
        '新たなチャンネルを発見!
        m_colChannel.Add New Collection, CStr(objCell.offsetLeft)
        List1.AddItem strSingleLine
      End If
    Else
      '番組をスキャン中...
      If Not blnNumeric And Not blnEmpty Then
        '番組内容をチャンネル毎のCollectionに追加
        m_colChannel(CStr(objCell.offsetLeft)).Add objCell.innerText
      End If
    End If
  Next
  '(!)ForEachは最初にチャンネルセルをまとめてくれるという期待のもと...
End Sub

Private Sub List1_Click()
  Dim varItem As Variant
  Dim Temp_Bangumi As String

  For Each varItem In m_colChannel(List1.ListIndex + 1)
    Temp_Bangumi = Temp_Bangumi & CStr(varItem) & vbNewLine
  Next
  RichTextBox1.Text = Temp_Bangumi
End Sub

もず 2003-11-06 07:57:53 No: 109653

たろうさん、red-fishさん、十分役に立ちそうです。
ありがとうございます。
red-fishさんのようにしたほうが、いいかも。
確かに、これなら見やすいですね。