動画番号から動画情報を取得するために組んだエクセルマクロ
閉じる
閉じる

新しい記事を投稿しました。シェアして読者に伝えましょう

×

動画番号から動画情報を取得するために組んだエクセルマクロ

2013-02-05 04:26
    http://ll.la/gIDC6に入っているマクロのドキュメント。

    ・エクセル2013プレビューにて動作確認。

    ・http://i.nicovideo.jp/v3/video.array?v=smXX,nmXX,soXX,.... を使用。
    ・http://i.nicovideo.jp/v3/video.array?v=は存在しない番号投げたときは何にも反応しない→
     とりあえず指定された番号にsm、nm、soくっつけて
     どれが存在するか(or全部存在しないか)は向こうで判断してもらう

    ・きったないコードなのでそのまま使わないようにw

    ・筆者環境(Phenom II X6 1090T + 16GB)で
     30000動画調べるのに1200秒程度かかります。

    ・ユーザーIDは取得できないのでサムネAPIから別途拾ってくる必要あり
     このマクロは番号は知ってるけどsm、nm、soどれが使われてるか未知のときに使う
     特にi.nicovideoはコミュ限とそうでない動画を区別しないので注意!

    ・書いてて思ったけどブロマガにソースコードは載せるべきじゃない。
     横に狭いw

    --------------以下ソースコード----------------------

    Sub
    iVideoCounter()

    'だらしねぇ変数宣言
    Dim t
    Dim u
    Dim Int_sm
    Dim offset
    Dim LoopCounter
    Dim t_result

    t = Timer

    'これを変更することで好きなIDから取得できる

    Int_sm = 19970001
    offset = 3
    LoopCounter = 600

    For j = 1 To LoopCounter

      'ありらいおんさん曰く最近はsm、nm、so以外の動画はないそうだ

      'つまりこんなURL生成でも多分対応できるはず
      'IDは向こう側である、ないを判断してくれるので便利
      '投げる動画番号は一度に150程度が限界?

      
    u = "http://i.nicovideo.jp/v3/video.array?v="

      
    For i = Int_sm To Int_sm + 49
        u = u & "sm" & i & "," & "nm" & i & "," & "so" & i & ","
      Next

      Call iVideoAPI(u, offset)
      Int_sm = Int_sm + 50

      If j <> LoopCounter Then

        
    offset = ThisWorkbook.Worksheets("Sheet2").Range("A1").End(xlDown).Row + 1
      
    End If

    Next

    t_result = Timer - t
    MsgBox t_result
    ThisWorkbook.Worksheets("Sheet2").Range("B1") = t_result

    End Sub

    Sub iVideoAPI(url, offset)

    'ソースはほぼこれを流用
    'http://www2d.biglobe.ne.jp/~t_yoshi/xml.html

    Dim XmlDoc As DOMDocument 'xmlデータ用変数
    Dim FileValue As Boolean '読み込み状態用
    Dim SelNode, TagNode As IXMLDOMNodeList

    Set XmlDoc = CreateObject("Microsoft.XMLDom")
    XmlDoc.async = False

    With ThisWorkbook.Worksheets("Sheet2")

    '高速化の呪文
    Application.ScreenUpdating = False
    FileValue = XmlDoc.Load(url)

    If FileValue Then

      'これがokでないと読み込めたことにならない
      Set SelNode = XmlDoc.selectNodes("nicovideo_video_response/@status")
      If SelNode(0).Text = "ok" Then

      '読み込んだ動画情報の数を数える処理
      Set SelNode = XmlDoc.selectNodes("nicovideo_video_response/video_info")
      SLen = SelNode.Length

      For i = 0 To SLen - 1

        'iPhone用APIとにらめっこしながら必要っぽい情報を拾っていく
        'タイトルとかタグは予めエクセル側でデータを「文字列」として扱っておくことが必要
        'その上で、禁則文字に対応するためタイトルとタグは最初に「'」を入れることでエクセル側に文字列として扱わせておく
        '7行目は後でユーザID入れたり一致フラグ用に使ったりするためここでは空けておく

        .Cells(i + offset, 1).Value = XmlDoc.selectNodes("nicovideo_video_response/video_info/video/id")(i).Text
        .Cells(i + offset, 2).Value = "'" & XmlDoc.selectNodes("nicovideo_video_response/video_info/video/title")(i).Text
        .Cells(i + offset, 3).Value = XmlDoc.selectNodes("nicovideo_video_response/video_info/video/view_counter")(i).Text
        .Cells(i + offset, 4).Value = XmlDoc.selectNodes("nicovideo_video_response/video_info/thread/num_res")(i).Text
        .Cells(i + offset, 5).Value = XmlDoc.selectNodes("nicovideo_video_response/video_info/video/mylist_counter")(i).Text
        .Cells(i + offset, 6).Value = XmlDoc.selectNodes("nicovideo_video_response/video_info/video/length_in_seconds")(i).Text
        .Cells(i + offset, 8).Value = XmlDoc.selectNodes("nicovideo_video_response/video_info/video/deleted")(i).Text
        .Cells(i + offset, 9).Value = XmlDoc.selectNodes("nicovideo_video_response/video_info/video/first_retrieve")(i).Text

        'i番目の動画情報のタグ個数jを数えてその分だけタグを取得
        'ロックしてる、してないがほしいときは別途処理が必要

        For j = 0 To XmlDoc.selectNodes("nicovideo_video_response/video_info/tags")(i).selectNodes("tag_info/tag").Length - 1

          .Cells(i + offset, j + 10) = "'" & XmlDoc.selectNodes("nicovideo_video_response/video_info/tags")(i).selectNodes("tag_info/tag")(j).Text

        Next

      Next

      Else

        .Cells(i, 1) = "not found or invalid"

      End If

    Else

      .Cells(i, 1).Value = "False"

    End If

    '高速化復帰の呪文
    Application.ScreenUpdating = True

    End With

    End Sub

    広告
    コメントを書く
    コメントをするには、
    ログインして下さい。