ニコニコ生放送 放送履歴取得Excelマクロ

お気に入りのニコニコ生放送を見ていて、コミュニティの放送履歴を全部取得して整理したくなりました。

私の好きな生放送主さんは、色々なレトロゲームを生放送されています。

ふと・・・
「あのゲームの生放送は何枠かかったんだろう？」
「あのゲームの生放送は何時頃クリアしたんだろう？」

そんな疑問に行き着き、つい取得したくなった訳ですが、ニコニコ生放送の放送履歴ページを、1ページずつクリックして表示させるのは大変です。

王様フラッ○ーだけで360枠突破・・・12ページ・・・いや、なんでもないです。

話は飛びますが、現在の仕事はExcelのマクロに接する機会が多く・・・っていうかそればっかりになってきてるので、Webからの情報取得はお手の物です。WEBクエリやIE操作、果てはソースを取得してhtmlタグを解析したり・・・いや愚痴になるのでやめましょう。
話は戻って「じゃあ、つくってみるか・・・」と、有給休暇で連休を作った初日に、何故か仕事と変らない事に手をつけてしまいました。

単純に取得するだけのマクロなら2時間くらいで作れたんですが、なんとなく需要がありそうなので、できるだけ分かりやすいマクロに改良していると4時間くらいかかってしまいました。・・・さらに、予約枠の場合「開場」なんて行があるため、その法則崩れ対策＆取得やりなおしで＋1時間、結局5時間もマクロを組んでいたことになります。

・・・まぁ、好きなんでしょうね、この程度のプログラミングなら。今の部署に移って来てからストレスはあまり感じませんからね。

せっかくですから、ブログネタにします。

ニコニコ生放送　放送履歴取得Excelマクロ
http://homepage2.nifty.com/gamearc/Free/niconamacro.zip

使用方法は、設定シートにコミュ番号を入れて、実行してください。

環境にもよりますが、1ページ10秒前後で取得できると思います。
あとはメッセージが出るまで待つだけです。

保存は行っておりませんので、必要なシートだけ別ファイルに保存するといいでしょう。念のため、設定シートのF列を見て前後のURLをブラウザで開いて確認して下さい。

ハッキリ言って、バグやしょうもないミスは沢山してると思います。

ほぼ全ての終了パターンがエラー処理で終わる仕組みなので、あまり褒められたプログラムじゃありません。また、サイトのレイアウトが変わると対応できない仕様です。

注意：放送履歴が無いコミュ番号などを入れて実行するといきなりエラーになります。
使用・改造については、すべて自己責任でお願いします。
コメントを入れまくってますので、それなりに理解しやすいと思います。
「全てのエラー」＝「取得部分が無い」と判断して、取得終了との表示がでます。

なお、設定シートは関数でURLを作っているだけなので、F11～F2011までにURLを入れることと「作業用」シートさえあれば文末に公開するプロシージャーをモジュールにいれて実行できます。

そのため「興味はあるけど変なウィルス絡みだったら嫌だな～」って方は、必要な部分を自由にパクッてご活用ください。

--------------

Option Explicit

Sub ニコ生履歴取得()

'　ニコニコ生放送履歴取得Excelマクロ　by Rei2793
'
'
'　WEBの取得方法は、「WEBクエリ」や「IEを操作」「ソースを取得」など色々ありますが
'　今回は頒布用になるべく手順が見えるよう、「ブックを開く」でURLを入れる方法を取ります。
'
'　変数を指定します。構想では色々考えていたので、使ってない変数が沢山あります。

'追記：変数の指定を一度に行ってますが、この方法は右端以外は「Variant」形式となります。　

    Dim URL行, URL列, 判定行, X As Long           '行数、列数を指定　URL用と判定用 そして配列変数用のX
    Dim 行, 列, 読行, 読列, 書行, 書列 As Long    '行数、列数を指定　読み込み用と書き込み用
    Dim 自ブック, 自シート As String              'ファイル名・シート名変更に対応するための文字列指定
    Dim 履歴ページ As String                      '履歴ページの文字列指定
    Dim 保存先, ファイル名   As String            '保存先、ファイル名用文字列指定
    Dim コミュ番号, 履歴URL As String             '履歴URL用文字列指定
    Dim 放送日時(30)  As Date                     '取得用日時を配列変数に指定　1to30　・・・いやなんでもないです
    Dim 放送主(30), タイトル(30) As String        '取得用文字列を配列変数に指定
    Dim 説明文(30), 開演(30) As String            '取得用文字列を配列変数に指定
    Dim シート判別 As Object                      'ワークシート用オブジェクト指定

   
On Error GoTo エラー処理                      'エラー処理＝取得完了と判断します。

    Application.DisplayAlerts = False             '警告メッセージを出さない

'　ここから実行用のプロシージャー

    自ブック = ActiveWorkbook.Name                'ThisWorkBook.Name でもいいです。
    自シート = ActiveSheet.Name
   
    Workbooks(自ブック).Activate                  'ブック指定
    Sheets("作業用").Select                       '作業用シートをクリア
    Range(Cells(2, 1), Cells(65536, 256)).Select  '2行目以降を直接選択し、
    Selection.Delete Shift:=xlUp                  '問答無用で削除

    書行 = 2
   
    Sheets(自シート).Activate                     'シート指定
    Range("F11:F2011").ClearContents              '取得完了マークをクリア
   
    コミュ番号 = Cells(6, 2)
   
    For Each シート判別 In ActiveWorkbook.Sheets  'ワークシートの数だけ繰り返す
      If コミュ番号 = シート判別.Name Then        'コミュ番号のシートがあれば
        Sheets(コミュ番号).Delete
      End If
    Next
   
   
   
'　履歴用URLを読み取り、なくなるまでループします。

    URL行 = 11                                    'URLの行数を代入。
    Do While Cells(URL行, 2) <> ""                'URL列の文字列がなくなるまでループします。
      
      Workbooks(自ブック).Activate                'ブック指定
      Sheets(自シート).Select                     'シートの指定
      
      履歴URL = Cells(URL行, 5).Value             'URLにリンク先を入れます。
      If URL行 > 11 Then Cells(URL行 - 1, 6) = "取得完了"    '前行がうまくいったと仮定して記しを入れます。
      
      
'「ブックを開く」でURLを入れ 読み取り専用で開きます。（警告メッセージは止めておりますが・・・）
      Workbooks.Open Filename:=履歴URL, ReadOnly:=True
      履歴ページ = ActiveWorkbook.Name            '履歴ページのブック名を取得
      
      Workbooks(履歴ページ).Activate          'ブック指定
      
      判定行 = 1: X = 1                           '1行目から読み取って判定に利用します。配列変数も1から。
      
      Do While 判定行 < 200                      '200行までループ　（200というのは適当）
'読み取り

        Workbooks(履歴ページ).Activate          'ブック指定
        If Cells(判定行, 1) = "放送日時" Then     '放送日時の文字列を見つけたら　end if まで実行
         
          読行 = 判定行 + 1
         
          X = 1
          Do While X <> 31                        'Xが31以外ならループを続ける
          '「ぎゃぁぁぁぁ　予約枠には「開場」って行があって法則が崩れた～！」対策
            
            If Left(Cells(読行, 1), 2) = "20" And Mid(Cells(読行, 1), 5, 1) = "/" Then  '日付っぽいなら
            
                放送日時(X) = Cells(読行, 1)
                  放送主(X) = Cells(読行, 2)
                タイトル(X) = Cells(読行, 3)
                  説明文(X) = Cells(読行, 4)
            
              If "開場" = Left(Cells(読行 + 1, 1), 2) Then                '開場の特殊対応
                開演(X) = Right(Cells(読行 + 2, 1), 5)  '開演だけ特殊なので、右から5文字を代入
                Else
                開演(X) = Right(Cells(読行 + 1, 1), 5)  '開演だけ特殊なので、右から5文字を代入
              End If
               
              X = X + 1                    '日付行が見つかる＝代入が完了したと判断して次の配列変数へ
          
            End If
            読行 = 読行 + 1
            If 読行 = 10000 Then Exit Do   '読込行が10000行を超えたら終了

          Loop
       
       
'作業用に書き込み
         
          Workbooks(自ブック).Activate                'ブック指定
          Sheets("作業用").Select                     'シートの指定
         
          For X = 1 To 30                             '配列に代入しただけ繰り返す
            Cells(書行 + X - 1, 1) = 放送日時(X)      '美しない数式・・・orz
            Cells(書行 + X - 1, 2) = 開演(X)
            Cells(書行 + X - 1, 3) = 放送主(X)
            Cells(書行 + X - 1, 4) = タイトル(X)
            Cells(書行 + X - 1, 5) = 説明文(X)
            Cells(書行 + X - 1, 6) = Now              '取得日時を入れます。
          Next
          書行 = 書行 + 30                            '一ページ30履歴と判断して。法則崩れたらごめんなさい。
            
        End If
        判定行 = 判定行 + 1                          '次の行へ
      Loop
   
      Workbooks(履歴ページ).Activate                    'ブック指定
      ActiveWindow.Close                                '履歴ページを閉じる。
   
      
      URL行 = URL行 + 1
      Workbooks(自ブック).Activate                  'ブック指定
      Sheets(自シート).Activate                     'シート指定

    Loop
    Workbooks(自ブック).Activate                  'ブック指定
    ThisWorkbook.Sheets("作業用").Copy after:=Sheets(コミュ番号)    '作業用シートを複写

    Workbooks(自ブック).Activate                  'ブック指定
    Sheets(コミュ番号).Select                     'シートの指定
   
    MsgBox "取得完了しました。（注意：保存は行ってません。）"

    Application.DisplayAlerts = True              '警告メッセージを出す

Exit Sub

エラー処理:
   
    Workbooks(自ブック).Activate                  'ブック指定
    ThisWorkbook.Sheets("作業用").Copy after:=Sheets(コミュ番号)    '作業用シートを複写

    Workbooks(自ブック).Activate                  'ブック指定
    Sheets(コミュ番号).Select                     'シートの指定
   
   
    Application.DisplayAlerts = True              '警告メッセージを出す

    MsgBox "取得完了したかも。（注意：保存は行ってません。）"

End Sub