とっても暇なブログw

ニコニコ動画の「踊ってみた」カテゴリーで活動する素敵な女の娘(こ)達を中心に、その文化?の展開を楽しく見守っていきたいと思います。
元気をもらえる彼女達のパワーは、本当に頼もしいですねw


テーマ:
VB で IE 操作に挑戦をしていたのですが、うまくいかず、それでは 最初から集計目的で、Excel にデータを収集するものとして、こんなマクロを作ってみましたw

Windows7 + Excel2002 の環境で作っているので、使える人はいるのでしょうか?

なお、お約束ですが、使用にあったっては自己責任でお願いしますw

何があっても、文句や泣き言は無しですw

保存先(OneDrive)

http://1drv.ms/1wFRRP7


最初の画面ですw

①カテゴリー(例:踊ってみた)、②ソート条件(例:マイリスが多い順)、③データ収集のページ数(Max.62)を設定し、「スタートボタン」をクリックw

Niconico-01


データを収集した結果w

Niconico-02


sheet2 では、sheet1 のメニュー項目の設定や、VBAで使用する参照先や変数等を作ったりしていますw

Niconico-03




動画説明w




懐かしいランキング動画w
http://www.nicovideo.jp/mylist/16720797


以下、VBAのきたないソースw
なんたって初めて2週間しか、経ってませんから、大目に見てあげてくださいw

<VBAソース>
Private Sub CommandButton1_Click()

Dim objIE As Object
Dim strHtlm As String
Dim URL As String
Dim TXT As String
Dim doc As Object
Dim ret As Long
Dim i As Long

Dim dataQuantity As Long
Dim repeatNumber As Long
Dim n As Integer

Dim m As Long
Dim k As Integer

Dim strValue As String

'検索結果画面のクリア
Range(Cells(5, 4), Cells(65536, 13)).Clear

Range(Cells(5, 4), Cells(65536, 4)).NumberFormatLocal = "dd/mm/yy hh:mm"
With Range(Cells(5, 4), Cells(65536, 4))
.HorizontalAlignment = xlCenter
End With

'指定のURLを表示する
URL = Worksheets("Sheet2").Cells(3, 11).Value
TXT = ThisWorkbook.Path & "\objIE_Source.txt"

Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.Navigate (URL)

Call WaitFor(5)

'「objIE_Source.txt」にサイトのソースを記録する
Set doc = objIE.document
strHtml = doc.DocumentElement.outerhtml
strHtml = Replace(strHtml, vbLf, vbCrLf)

i = FreeFile
Open TXT For Output As i
Print #i, strHtml
Close #i

'「Notepad」を開いて、サイトのソースを表示する
'ret = Shell("Notepad.Exe " & TXT, vbNormalFocus)

'データ取得件数の保存(ページ数x32)
dataQuantity = 32 * Cells(24, 2).Value

Worksheets("Sheet1").Range(Cells(2, 10), Cells(2, 12)).Copy Worksheets("Sheet1").Range(Cells(5, 10), Cells(dataQuantity + 4, 10))

'データ取得件数の限度チェック
If dataQuantity > 2000 Then
dataQuantity = 2000
End If

k = "0"

DataCollection:

'データ取得件数のチェック
If dataQuantity > 32 Then
repeatNumber = 32
Else: repeatNumber = dataQuantity
End If

dataQuantity = dataQuantity - 32

'データ取得の処理
For n = 1 To repeatNumber Step 1
strValue = objIE.document.getElementsByClassName("itemTime")(n - 1).innerText 'Get "Title"
Cells(4 + n + (k * 32), 4) = Strings.Left(strValue, Len(strValue) - 2)

Cells(4 + n + (k * 32), 5) = objIE.document.getElementsByClassName("itemTitle")(n + 7).innerText 'Get "Date & Time"

strValue = objIE.document.getElementsByClassName("count mylist")(n - 1).innerText 'Get "MyList"
Cells(4 + n + (k * 32), 6) = Mid(strValue, 3)

strValue = objIE.document.getElementsByClassName("count view")(n - 1).innerText 'Get "PlayMovie"
Cells(4 + n + (k * 32), 7) = Mid(strValue, 3)

strValue = objIE.document.getElementsByClassName("count comment")(n - 1).innerText 'Get "Comment"
Cells(4 + n + (k * 32), 8) = Mid(strValue, 3)

strValue = objIE.document.getElementsByClassName("count ads")(n - 1).innerText 'Get "AD"
Cells(4 + n + (k * 32), 9) = Mid(strValue, 3)

m = "0"

For j = 1 To 33 - n
m = InStrRev(strHtml, "uadWrap", m - 1)
Next j

Cells(4 + n + (k * 32), 13) = Mid(strHtml, m + 68, 30) 'Get "Link"

Next n

'終了判断
If dataQuantity > 0 Then
k = k + 1
URL = Worksheets("Sheet2").Cells(3 + k, 11).Value
objIE.Navigate (URL)

Call WaitFor(5)

'「objIE_Source.txt」にサイトのソースを記録する
Set doc = objIE.document
strHtml = doc.DocumentElement.outerhtml
strHtml = Replace(strHtml, vbLf, vbCrLf)

i = FreeFile
Open TXT For Output As i
Print #i, strHtml
Close #i

'「Notepad」を開いて、サイトのソースを表示する
'ret = Shell("Notepad.Exe " & TXT, vbNormalFocus)

GoTo DataCollection
End If

Close:

objIE.Quit
Set objIE = Nothing

End Sub

'IEを待機する関数
Function IEWait(ByRef objIE As Object)

While (objIE.Busy)
Wend
While (objIE.document.ReadyState <> "complete")
Wend

End Function

'指定した秒だけ停止する関数
Function WaitFor(ByVal second As Integer)

Dim futureTime As Date
futureTime = DateAdd("s", second, Now)

While Now < futureTime
DoEvents
Wend

End Function

Function htmlFileOut(objIE)

Set doc = objIE.document
strHtml = doc.DocumentElement.outerhtml
strHtml = Replace(strHtml, vbLf, vbCrLf)

i = FreeFile
Open TXT For Output As i
Print #i, strHtml
Close #i

'「Notepad」を開いて、サイトのソースを表示する
'ret = Shell("Notepad.Exe " & TXT, vbNormalFocus)

End Function
AD
いいね!した人  |  コメント(0)  |  リブログ(0)

とっても暇でしさんの読者になろう

ブログの更新情報が受け取れて、アクセスが簡単になります

最近の画像つき記事  もっと見る >>

AD

Ameba人気のブログ

Amebaトピックス

      ランキング

      • 総合
      • 新登場
      • 急上昇
      • トレンド

      ブログをはじめる

      たくさんの芸能人・有名人が
      書いているAmebaブログを
      無料で簡単にはじめることができます。

      公式トップブロガーへ応募

      多くの方にご紹介したいブログを
      執筆する方を「公式トップブロガー」
      として認定しております。

      芸能人・有名人ブログを開設

      Amebaブログでは、芸能人・有名人ブログを
      ご希望される著名人の方/事務所様を
      随時募集しております。