piyopiyo@ぴよのしゅけ
日記
最終更新：
Bot(ページ名リンク)
-
view
Top > 日記
- デブがデブをデブという -- ぴよ (2010-09-15 08:27:19)
- swfobjがVBAで触れない。。。。 -- ぴよ (2010-10-08 22:16:21)
memo
1:5
2:2
3:7
4:?
5:6
6:3,4
7,3,2
9,5,4
a,1,1
q,4,5
b,?,?
c,?,4
d,?,9
2:2
3:7
4:?
5:6
6:3,4
7,3,2
9,5,4
a,1,1
q,4,5
b,?,?
c,?,4
d,?,9
Private Sub bGET_TAN_Click()
'情報メニューを起動する(クリックする)
Dim n As Integer 'ループのカウンター
Dim nLinkNo As Integer '見つけたメニューの番号
nLinkNo = -1 'エラーの-1で初期化する
For n = 0 To Me.WebBrowser2.Document.Links.Length - 1 'リンクオブジェクトから探る
'タイトルが情報メニューのリンクを探す
If Me.WebBrowser2.Document.Links(n).Title = "情報メニュー" Then
nLinkNo = n '見つけた番号をセットする。
Exit For '見つけたのでループを抜ける。
End If
Next n
'エラーの判断
If nLinkNo = -1 Then '-1のまま、見つからなかったら、エラーにする。
MsgBox "情報メニューが見つかりません、システム管理者に連絡してください"
Exit Sub '関数を抜ける
End If
'見つけたリンクを押す .Click
Me.WebBrowser2.Document.Links(nLinkNo).Click '単純に.Clickメソッドを使う
'↑次は、ここで起動した 情報メニューを捕まえないとなぁ。。。
Dim objOYA_TAG As Object '親のオブジェクトを入れる
Set objOYA_TAG = tagSELECT.Item("g").parentElement
While objOYA_TAG.tagname <> "FORM" 'タグの名前がFORMになるまで(FORM以外の間まわる)
Set objOYA_TAG = objOYA_TAG.parentElement 'さらに、一つ上の親タグを代入
Wend
objOYA_TAG.Submit '上へ行き、見つけたフォームを.Submit 送信処理
'フォーム(0番目)を .Submit(送信・投稿) する objIE.Document.Forms(0).Submit '送信処理
Option Explicit
Dim wait_time As Integer
Dim newpage As Integer
Dim banne_html As String
Sub test2()
Dim objie
Dim objshell
Dim wait_time As Integer
Dim newpage As Integer
Dim banne_html As String
Sub test2()
Dim objie
Dim objshell
Set objshell = CreateObject("Shell.Application")
Set objie = CreateObject("InternetExplorer.Application")
objie.Visible = True 'IEウィンドウを表示
objie.Navigate2 "http://profile.ameba.jp/katharine1209/" '一度アメログのMypage-Topに入る
'objie.Quit 'ここで閉じるのはCreateObjectで作成したウィンドウ
'Set objie = Nothing
'Set objie = objshell.Windows.Item(objshell.Windows.Count - 1)
wait_time = 10
wait
Set objie = CreateObject("InternetExplorer.Application")
objie.Visible = True 'IEウィンドウを表示
objie.Navigate2 "http://profile.ameba.jp/katharine1209/" '一度アメログのMypage-Topに入る
'objie.Quit 'ここで閉じるのはCreateObjectで作成したウィンドウ
'Set objie = Nothing
'Set objie = objshell.Windows.Item(objshell.Windows.Count - 1)
wait_time = 10
wait
objie.Navigate2 "http://peta.ameba.jp/p/addPeta.do?targetAmebaId=katharine1209" 'Firstペタランクへ移動
MsgBox "test", vbOKOnly
End Sub
Sub test1()
Dim objie
Dim objshell
'Shell.Applicationオブジェクトの作成
Set objshell = CreateObject("Shell.Application")
Set objie = CreateObject("InternetExplorer.Application")
objie.Visible = True 'IEウィンドウを表示
objie.Navigate2 "http://www.ameba.jp/" '一度アメログのMypage-Topに入る
objie.Quit 'ここで閉じるのはCreateObjectで作成したウィンドウ
Set objie = Nothing
Set objie = objshell.Windows.Item(objshell.Windows.Count - 1)
wait_time = 10
wait
Sub test1()
Dim objie
Dim objshell
'Shell.Applicationオブジェクトの作成
Set objshell = CreateObject("Shell.Application")
Set objie = CreateObject("InternetExplorer.Application")
objie.Visible = True 'IEウィンドウを表示
objie.Navigate2 "http://www.ameba.jp/" '一度アメログのMypage-Topに入る
objie.Quit 'ここで閉じるのはCreateObjectで作成したウィンドウ
Set objie = Nothing
Set objie = objshell.Windows.Item(objshell.Windows.Count - 1)
wait_time = 10
wait
objie.Navigate2 "http://profile.ameba.jp/katharine1209/" 'Firstペタランクへ移動
wait_time = 10
wait
objie.Navigate2 "http://peta.ameba.jp/p/addPeta.do?targetAmebaId=katharine1209"
wait_time = 10
wait
objie.Navigate2 "http://peta.ameba.jp/p/addPetaComplete.do?targetAmebaId=katharine1209"
'memo
'<script type="text/javascript">
'var so = new SWFObject("http://stat.ameba.jp/peta/user/swf/1/peta_button1.swf", "peta_button", "100%", "250", "8", "#ffffff");
'so.addParam("menu", "false");
'so.addParam("allowScriptAccess","always");
'so.addVariable("link", "/p/addPetaComplete.do");
'so.addVariable("petaId", "812b65fec6c47f291cb7f51619c70f20");
'so.addVariable("targetAmebaId", "banban-bike");
'so.write("flashContent");
'</script>
wait_time = 10
wait
objie.Navigate2 "http://peta.ameba.jp/p/addPeta.do?targetAmebaId=katharine1209"
wait_time = 10
wait
objie.Navigate2 "http://peta.ameba.jp/p/addPetaComplete.do?targetAmebaId=katharine1209"
'memo
'<script type="text/javascript">
'var so = new SWFObject("http://stat.ameba.jp/peta/user/swf/1/peta_button1.swf", "peta_button", "100%", "250", "8", "#ffffff");
'so.addParam("menu", "false");
'so.addParam("allowScriptAccess","always");
'so.addVariable("link", "/p/addPetaComplete.do");
'so.addVariable("petaId", "812b65fec6c47f291cb7f51619c70f20");
'so.addVariable("targetAmebaId", "banban-bike");
'so.write("flashContent");
'</script>
End Sub
Sub peta_peta()
'IE_Obj
UF1.PB1.Value = 0
If (Range("D5").Value < 1 Or Range("D5").Value > 50) Then
'IE_Obj
UF1.PB1.Value = 0
If (Range("D5").Value < 1 Or Range("D5").Value > 50) Then
MsgBox "D5に1～50の数字を入れてください", vbOKOnly Exit Sub
End If
If (Range("D6").Value < 1 Or Range("D6").Value > 50) Then
If (Range("D6").Value < 1 Or Range("D6").Value > 50) Then
MsgBox "D6に1～50の数字を入れてください", vbOKOnly Exit Sub
End If
If (Range("D5").Value > Range("D6").Value) Then
If (Range("D5").Value > Range("D6").Value) Then
MsgBox "D5セルはD6より小さい値(1-50)を入れてください", vbOKOnly Exit Sub
End If
UF1.LB2.Caption = "0/" & Range("D6").Value
UF1.TB1.Text = UF1.TB1.Text & "IE起動" & (Chr(13) + Chr(10))
Dim objie
Dim objshell
'Shell.Applicationオブジェクトの作成
Set objshell = CreateObject("Shell.Application")
'IEオブジェクトの作成(ダミー)
Set objie = CreateObject("InternetExplorer.Application")
objie.Visible = True 'IEウィンドウを表示
objie.Navigate2 "http://www.ameba.jp/" '一度アメログのMypage-Topに入る
objie.Quit 'ここで閉じるのはCreateObjectで作成したウィンドウ
Set objie = Nothing 'いったんオブジェクトをクリア
'Shell.ApplicationオブジェクトのWindowオブジェクトからIEオブジェクトを取り出す
'作成されているポイントは、Windowsコレクションの最後の要素
Set objie = objshell.Windows.Item(objshell.Windows.Count - 1)
wait_time = 20
wait
'---- login script ----
'objIE.Document.srvLoginForm.amebaId.Value = "xxx"
'objIE.Document.srvLoginForm.Password.Value = "xxx"
'objIE.Document.styLoginForm.Submit.Click
UF1.LB2.Caption = "0/" & Range("D6").Value
UF1.TB1.Text = UF1.TB1.Text & "IE起動" & (Chr(13) + Chr(10))
Dim objie
Dim objshell
'Shell.Applicationオブジェクトの作成
Set objshell = CreateObject("Shell.Application")
'IEオブジェクトの作成(ダミー)
Set objie = CreateObject("InternetExplorer.Application")
objie.Visible = True 'IEウィンドウを表示
objie.Navigate2 "http://www.ameba.jp/" '一度アメログのMypage-Topに入る
objie.Quit 'ここで閉じるのはCreateObjectで作成したウィンドウ
Set objie = Nothing 'いったんオブジェクトをクリア
'Shell.ApplicationオブジェクトのWindowオブジェクトからIEオブジェクトを取り出す
'作成されているポイントは、Windowsコレクションの最後の要素
Set objie = objshell.Windows.Item(objshell.Windows.Count - 1)
wait_time = 20
wait
'---- login script ----
'objIE.Document.srvLoginForm.amebaId.Value = "xxx"
'objIE.Document.srvLoginForm.Password.Value = "xxx"
'objIE.Document.styLoginForm.Submit.Click
'Time Out
Dim time60 As Date
time60 = DateAdd("S", 60, Now())
Do While objie.Busy = True 'ビジー中待ち
DoEvents
If time60 < Now() Then
'修正必要
' MsgBox "タイムアウト", vbOKOnly
' Exit Sub
' MsgBox "タイムアウト", vbOKOnly
' Exit Sub
End If Loop
UF1.TB1.Text = UF1.TB1.Text & "Firstペタページへ" & (Chr(13) + Chr(10))
objie.Navigate2 "http://peta.ameba.jp/p/showPeta.do" 'Firstペタランクへ移動
wait_time = 20
wait
'next-page
objie.Navigate2 "http://peta.ameba.jp/p/showPeta.do" 'Firstペタランクへ移動
wait_time = 20
wait
'next-page
For newpage = Range("D5").Value To Range("D6").Value Step 1
If (newpage > 1) Then
UF1.TB1.Text = UF1.TB1.Text & newpage & "ペタページへ" & (Chr(13) + Chr(10))
If (newpage > 1) Then
UF1.TB1.Text = UF1.TB1.Text & newpage & "ペタページへ" & (Chr(13) + Chr(10))
objie.Navigate2 "http://peta.ameba.jp/p/showPeta.do?pageNo=" & newpage & "&allCount=1000"
End If
'--- 20秒待ち
wait_time = 20
wait
UF1.LB2.Caption = newpage & "/" & (Range("D6").Value - Range("D5").Value - 1)
UF1.PB1.Value = newpage / (Range("D6").Value - Range("D5").Value + 1) * 100
'--- 20秒待ち
wait_time = 20
wait
UF1.LB2.Caption = newpage & "/" & (Range("D6").Value - Range("D5").Value - 1)
UF1.PB1.Value = newpage / (Range("D6").Value - Range("D5").Value + 1) * 100
'HTMLソース取得
UF1.TB1.Text = UF1.TB1.Text & "ソース取得" & (Chr(13) + Chr(10))
Dim strHTML As String
On Error GoTo error_skip
UF1.TB1.Text = UF1.TB1.Text & "ソース取得" & (Chr(13) + Chr(10))
Dim strHTML As String
On Error GoTo error_skip
Range("D" & (newpage - 1) * 20 + 10).Select
Dim i As Integer
Dim z As Integer
Dim sLink As String
Dim sALL As String
Dim b As Integer
Dim c As String
Dim Mystr As String
z = 1
Dim z As Integer
Dim sLink As String
Dim sALL As String
Dim b As Integer
Dim c As String
Dim Mystr As String
z = 1
For i = 0 To objie.Document.all.Length - 1
'deb MsgBox objIE.Document.Links(i).outerText
'deb MsgBox objIE.Document.Links(i).href
'deb MsgBox objIE.Document.Links(i).outerHTML
' sLink = objIE.Document.Links(i).outerHTML
'deb MsgBox objIE.Document.Links(i).href
'deb MsgBox objIE.Document.Links(i).outerHTML
' sLink = objIE.Document.Links(i).outerHTML
sALL = objie.Document.all(i).innerHTML
' Range("L10").Value = objIE.Document.All(i).InnerHTML
' If (InStr(1, sLink, "ブログを見る", 1) > 0) Then
' If (InStr(1, sLink, "ブログを見る", 1) > 0) Then
If (InStr(1, sALL, "時", 1) = 3) Then
If (InStr(1, sALL, "分", 1) = 6) Then
Range("D" & (newpage - 1) * 20 + 10).Cells(z, 2).Value = objie.Document.all(i).innerHTML
Range("D" & (newpage - 1) * 20 + 10).Cells(z, 0).Value = objie.Document.all(i - 4).innerHTML
sLink = objie.Document.all(i - 5).innerHTML
b = InStr(1, sLink, "ameba.jp/", 1)
c = Mid(sLink, b)
b = InStr(1, c, "/", 1)
Mystr = Mid(c, b + 1)
b = InStr(1, Mystr, "/")
c = Mid(Mystr, 1, b - 1)
Range("D" & (newpage - 1) * 20 + 10).Cells(z, 1).Value = c
Range("D" & (newpage - 1) * 20 + 10).Cells(z, 3).Value = "http://peta.ameba.jp/p/addPetaComplete.do?targetAmebaId=" & c & "&petaID=" & Range("D3").Value
End If
z = z + 1
End If
Next i
Next newpage
UF1.LB2.Caption = "100%"
UF1.PB1.Value = 100
UF1.TB1.Text = UF1.TB1.Text & "終了処理" & (Chr(13) + Chr(10))
'--------------終了処理------------------------------
objie.Quit
Set objie = Nothing
Set objshell = Nothing
If (UF1.OB3.Value = False) Then
UF1.LB2.Caption = "100%"
UF1.PB1.Value = 100
UF1.TB1.Text = UF1.TB1.Text & "終了処理" & (Chr(13) + Chr(10))
'--------------終了処理------------------------------
objie.Quit
Set objie = Nothing
Set objshell = Nothing
If (UF1.OB3.Value = False) Then
MsgBox "目的通り終了＾＾", vbOKOnly
End If
Exit Sub
error_skip2:
Set objie = Nothing
Set objshell = Nothing
Exit Sub
error_skip:
MsgBox "Errorです。" & (newpage - 1) * 20 & "まで取得できました", vbOKOnly
GoTo error_skip2
objie.Quit
End Sub
Exit Sub
error_skip2:
Set objie = Nothing
Set objshell = Nothing
Exit Sub
error_skip:
MsgBox "Errorです。" & (newpage - 1) * 20 & "まで取得できました", vbOKOnly
GoTo error_skip2
objie.Quit
End Sub
Sub peta_click()
If (Range("D7").Value < 1) Then
If (Range("D7").Value < 1) Then
MsgBox "D7セルに1～1000の数字を記載してください"
End If
If (Range("D8").Value > 1000) Then
If (Range("D8").Value > 1000) Then
MsgBox "D8セルに1～1000の数字を記載してください"
End If
If (Range("D8").Value < Range("D7").Value) Then
If (Range("D8").Value < Range("D7").Value) Then
MsgBox "D7セルをD8より小さくしてください"
End If
UF1.PB1.Value = 0
Dim objie
Dim objshell
Dim i As Integer 'Loop変数
On Error GoTo error_peta
UF1.TB1.Text = UF1.TB1.Text & "IE起動" & (Chr(13) + Chr(10))
'Shell.Applicationオブジェクトの作成
Set objshell = CreateObject("Shell.Application")
'IEオブジェクトの作成(ダミー)
Set objie = CreateObject("InternetExplorer.Application")
objie.Visible = True 'IEウィンドウを表示
objie.Navigate2 "http://www.ameba.jp/" '一度アメログのMypage-Topに入る
objie.Quit 'ここで閉じるのはCreateObjectで作成したウィンドウ
Set objie = Nothing 'いったんオブジェクトをクリア
Range("A10:A1009").Value = ""
Set objie = objshell.Windows.Item(objshell.Windows.Count - 1)
Dim jch As String
Dim ipb As Integer
UF1.PB1.Value = 0
Dim objie
Dim objshell
Dim i As Integer 'Loop変数
On Error GoTo error_peta
UF1.TB1.Text = UF1.TB1.Text & "IE起動" & (Chr(13) + Chr(10))
'Shell.Applicationオブジェクトの作成
Set objshell = CreateObject("Shell.Application")
'IEオブジェクトの作成(ダミー)
Set objie = CreateObject("InternetExplorer.Application")
objie.Visible = True 'IEウィンドウを表示
objie.Navigate2 "http://www.ameba.jp/" '一度アメログのMypage-Topに入る
objie.Quit 'ここで閉じるのはCreateObjectで作成したウィンドウ
Set objie = Nothing 'いったんオブジェクトをクリア
Range("A10:A1009").Value = ""
Set objie = objshell.Windows.Item(objshell.Windows.Count - 1)
Dim jch As String
Dim ipb As Integer
jch = "sato613"
Range("F10").Select
UF1.TB1.Text = UF1.TB1.Text & "ペタ実行開始" & (Chr(13) + Chr(10))
For i = Range("D7").Value To Range("D8").Value Step 1
UF1.LB2.Caption = ipb & "/" & (Range("D8").Value - Range("D7").Value + 1)
UF1.PB1.Value = ipb / (Range("D8").Value - Range("D7").Value + 1) * 100
UF1.PB1.Value = ipb / (Range("D8").Value - Range("D7").Value + 1) * 100
ipb = ipb + 1
If (InStr(1, jch, Range("F10").Cells(i, -1), 1) > 0) Then
Range("F10").Cells(i, -4).Value = "重複"
Else
objie.Navigate2 Range("F10").Cells(i, 1).Value
jch = jch & Range("F10").Cells(i, -1).Value & ","
wait_time = 10
wait
Range("F10").Cells(i, -4).Value = "OK"
End If
Next i
'------------- end message -----------------------
UF1.TB1.Text = UF1.TB1.Text & "ペタ終了"
MsgBox "目的通り終了"
objie.Quit
Set objie = Nothing
Set objshell = Nothing
Exit Sub
error_peta:
UF1.TB1.Text = UF1.TB1.Text & "ペタ終了"
MsgBox "目的通り終了"
objie.Quit
Set objie = Nothing
Set objshell = Nothing
Exit Sub
error_peta:
Range("F10").Cells(i, -4).Value = "NG"
UF1.TB1.Text = "ペタERROR"
MsgBox "ERROR" & i & "までペタできました"
objie.Quit Set objie = Nothing Set objshell = Nothing
End Sub
Sub wait()
'wait_time = 10
Dim newHour As Integer
Dim newMinute As Integer
Dim newSecond As Integer
Dim waitTime As Integer
Dim swait As String
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + wait_time
swait = newHour & ":" & newMinute & ":" & newSecond
Application.wait swait
End Sub
Sub get_html()
'ムームードメイン
'banner_html = "<a href=http://px.a8.net/svt/ejp?a8mat=1HW0T7+BJKL0Y+348+1BZYSH\ target=\"_blank">"
'<img border="0" width="88" height="31" alt="" src="http://www27.a8.net/svt/bgt?aid=090513691698&wid=001&eno=01&mid=s00000000404008062000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www17.a8.net/0.gif?a8mat=1HW0T7+BJKL0Y+348+1BZYSH" alt="">
Sub wait()
'wait_time = 10
Dim newHour As Integer
Dim newMinute As Integer
Dim newSecond As Integer
Dim waitTime As Integer
Dim swait As String
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + wait_time
swait = newHour & ":" & newMinute & ":" & newSecond
Application.wait swait
End Sub
Sub get_html()
'ムームードメイン
'banner_html = "<a href=http://px.a8.net/svt/ejp?a8mat=1HW0T7+BJKL0Y+348+1BZYSH\ target=\"_blank">"
'<img border="0" width="88" height="31" alt="" src="http://www27.a8.net/svt/bgt?aid=090513691698&wid=001&eno=01&mid=s00000000404008062000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www17.a8.net/0.gif?a8mat=1HW0T7+BJKL0Y+348+1BZYSH" alt="">
'ロリポップ
'<a href="http://px.a8.net/svt/ejp?a8mat=1HW0T7+EYTB8Y+348+60H7L" target="_blank">
'<img border="0" width="100" height="60" alt="" src="http://www21.a8.net/svt/bgt?aid=090513691905&wid=001&eno=01&mid=s00000000404001010000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www11.a8.net/0.gif?a8mat=1HW0T7+EYTB8Y+348+60H7L" alt="">
'<a href="http://px.a8.net/svt/ejp?a8mat=1HW0T7+EYTB8Y+348+60H7L" target="_blank">
'<img border="0" width="100" height="60" alt="" src="http://www21.a8.net/svt/bgt?aid=090513691905&wid=001&eno=01&mid=s00000000404001010000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www11.a8.net/0.gif?a8mat=1HW0T7+EYTB8Y+348+60H7L" alt="">
'<a href="http://px.a8.net/svt/ejp?a8mat=1HW0T8+4SNQ7M+348+ICD5D" target="_blank">
'<img border="0" width="125" height="125" alt="" src="http://www21.a8.net/svt/bgt?aid=090513692290&wid=001&eno=01&mid=s00000000404003081000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www13.a8.net/0.gif?a8mat=1HW0T8+4SNQ7M+348+ICD5D" alt="">
'<img border="0" width="125" height="125" alt="" src="http://www21.a8.net/svt/bgt?aid=090513692290&wid=001&eno=01&mid=s00000000404003081000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www13.a8.net/0.gif?a8mat=1HW0T8+4SNQ7M+348+ICD5D" alt="">
'チカッパ
'<a href="http://px.a8.net/svt/ejp?a8mat=1HW0T7+CF4K36+348+15PUCX" target="_blank">
'<img border="0" width="100" height="60" alt="" src="http://www26.a8.net/svt/bgt?aid=090513691751&wid=001&eno=01&mid=s00000000404007007000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www19.a8.net/0.gif?a8mat=1HW0T7+CF4K36+348+15PUCX" alt="">
'ヘムテル
'<a href="http://px.a8.net/svt/ejp?a8mat=1HW0T7+F4RNAQ+348+U3175" target="_blank">
'<img border="0" width="234" height="60" alt="" src="http://www22.a8.net/svt/bgt?aid=090513691915&wid=001&eno=01&mid=s00000000404005053000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www18.a8.net/0.gif?a8mat=1HW0T7+F4RNAQ+348+U3175" alt="">
'ライブドア
'<a href="http://px.a8.net/svt/ejp?a8mat=1HVS5B+8KEK4Y+1RHK+661TT" target="_blank">
'<img border="0" width="120" height="90" alt="" src="http://www22.a8.net/svt/bgt?aid=090502463518&wid=001&eno=01&mid=s00000008228001036000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www11.a8.net/0.gif?a8mat=1HVS5B+8KEK4Y+1RHK+661TT" alt="">
'<a href="http://px.a8.net/svt/ejp?a8mat=1HW0T7+CF4K36+348+15PUCX" target="_blank">
'<img border="0" width="100" height="60" alt="" src="http://www26.a8.net/svt/bgt?aid=090513691751&wid=001&eno=01&mid=s00000000404007007000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www19.a8.net/0.gif?a8mat=1HW0T7+CF4K36+348+15PUCX" alt="">
'ヘムテル
'<a href="http://px.a8.net/svt/ejp?a8mat=1HW0T7+F4RNAQ+348+U3175" target="_blank">
'<img border="0" width="234" height="60" alt="" src="http://www22.a8.net/svt/bgt?aid=090513691915&wid=001&eno=01&mid=s00000000404005053000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www18.a8.net/0.gif?a8mat=1HW0T7+F4RNAQ+348+U3175" alt="">
'ライブドア
'<a href="http://px.a8.net/svt/ejp?a8mat=1HVS5B+8KEK4Y+1RHK+661TT" target="_blank">
'<img border="0" width="120" height="90" alt="" src="http://www22.a8.net/svt/bgt?aid=090502463518&wid=001&eno=01&mid=s00000008228001036000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www11.a8.net/0.gif?a8mat=1HVS5B+8KEK4Y+1RHK+661TT" alt="">
'A8
'http://px.a8.net/svt/ejp?a8mat=1HU5F7+9DKSS2+0K+ZSD6A
'Get Monney
'http://dietnavi.com/pc/index.asp?id=1856115
'ドル箱
'http://dorubako.jp/regist.php?i=10435070
'http://px.a8.net/svt/ejp?a8mat=1HU5F7+9DKSS2+0K+ZSD6A
'Get Monney
'http://dietnavi.com/pc/index.asp?id=1856115
'ドル箱
'http://dorubako.jp/regist.php?i=10435070
'Potora
'http://px.a8.net/svt/ejp?a8mat=1HU5F7+DJM182+1R5C+6EU6Q
'げんだま
'<a href="http://px.a8.net/svt/ejp?a8mat=1HU6ZY+78RVQQ+1PH2+669JL" target="_blank">
'<img border="0" width="468" height="60" alt="" src="http://www21.a8.net/svt/bgt?aid=090428398438&wid=001&eno=01&mid=s00000007967001037000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www11.a8.net/0.gif?a8mat=1HU6ZY+78RVQQ+1PH2+669JL" alt="">
'http://px.a8.net/svt/ejp?a8mat=1HU5F7+DJM182+1R5C+6EU6Q
'げんだま
'<a href="http://px.a8.net/svt/ejp?a8mat=1HU6ZY+78RVQQ+1PH2+669JL" target="_blank">
'<img border="0" width="468" height="60" alt="" src="http://www21.a8.net/svt/bgt?aid=090428398438&wid=001&eno=01&mid=s00000007967001037000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www11.a8.net/0.gif?a8mat=1HU6ZY+78RVQQ+1PH2+669JL" alt="">
'<a href="http://px.a8.net/svt/ejp?a8mat=1HW5J9+F75F9E+1IDS+5YRHD" target="_blank">
'<img border="0" width="468" height="60" alt="" src="http://www27.a8.net/svt/bgt?aid=090519813919&wid=003&eno=01&mid=s00000007048001002000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www17.a8.net/0.gif?a8mat=1HW5J9+F75F9E+1IDS+5YRHD" alt="">
'<img border="0" width="468" height="60" alt="" src="http://www27.a8.net/svt/bgt?aid=090519813919&wid=003&eno=01&mid=s00000007048001002000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www17.a8.net/0.gif?a8mat=1HW5J9+F75F9E+1IDS+5YRHD" alt="">
'<a href="http://px.a8.net/svt/ejp?a8mat=1HW0T7+F4ROUA+348+U4YN5" target="_blank">
'<img border="0" width="120" height="90" alt="" src="http://www24.a8.net/svt/bgt?aid=090513691915&wid=003&eno=01&mid=s00000000404005062000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www12.a8.net/0.gif?a8mat=1HW0T7+F4ROUA+348+U4YN5" alt="">
'<img border="0" width="120" height="90" alt="" src="http://www24.a8.net/svt/bgt?aid=090513691915&wid=003&eno=01&mid=s00000000404005062000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www12.a8.net/0.gif?a8mat=1HW0T7+F4ROUA+348+U4YN5" alt="">
'<a href="http://px.a8.net/svt/ejp?a8mat=1HWDDK+EY7X6Q+YPG+HYV1D" target="_blank">
'<img border="0" width="224" height="33" alt="" src="http://www24.a8.net/svt/bgt?aid=090529976904&wid=003&eno=01&mid=s00000004498003018000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www12.a8.net/0.gif?a8mat=1HWDDK+EY7X6Q+YPG+HYV1D" alt="">
'<img border="0" width="224" height="33" alt="" src="http://www24.a8.net/svt/bgt?aid=090529976904&wid=003&eno=01&mid=s00000004498003018000&mc=1"></a>
'<img border="0" width="1" height="1" src="http://www12.a8.net/0.gif?a8mat=1HWDDK+EY7X6Q+YPG+HYV1D" alt="">
End Sub
End Sub
