せどりブログ成功例を一覧にする（WSH）

キャンペーン実施中!日本ファースト証券資料請求でCOCO壱番館500円飲食券を1枚プレゼント
↓より資料請求いただき、こちらのフォームより(1)資料請求日、(2)送付先の住所・お名前を連絡ください

せどりブログ成功例を一覧にする（WSH）

せどり成功者のブログを巡回し、そのブログのAMAZONへのリンク一覧のhtmをつくるシェル
せどりってどうよ!?さんの例です ■Windows/XP,IE6で動作確認済み
■使いかた
1.拡張子.vbsで適当なファイルを作成する
2.このvbsファイルをエディタで開く
3.下記ソースをコピー、上記で開いた.vbsのファイルに貼り付ける
4.巡回するブログURL、htmlファイル名など変更する
以下のソースはせどりってどうよ!?さんの例になってます。ソースの1-3行目を巡回するブログに変更してください
4行目以降に他のせどりさんの例をコメントで記載してます

#(ソースの行に同じ)	変数名	設定内容
1	urlIchiranTop	巡回するブログURL
2	nextPageText	ブログの次のページ移動のキーワード (a)この例のように次頁へのリンクテキストが”次のページへ”とか固定の場合そのテキストを指定 (b)次頁へのリンクテキストが不定のとき：次頁のURLの一部のテキストを指定。他のリンクとダブらないように注意 (c)次頁へのリンクテキストが不定のときで位置が固定のとき：その位置を0からの相対位置で指定 ---(b)(c)(a)の順で優先します---
3	textFile	htmlファイル名

5.保存・終了する
6.このvbsを実行（ダブルクリック）すると下記(1)→(2)(3)→(2)(3)の繰り返し
(1)楽天のランキングTOP画面
　(2)アフィリエイトリンク作成のURL入力画面にURL入力
(3)作成されたアフィリエイトリンクの画面
7.#4で変更したファイル名に一覧のhtmlファイルができる
■ソース

urlIchiranTop="http://hask.blog6.fc2.com/page-1.html" 'せどりってどうよ!? ←巡回するブログURL
nextPageText="次のページへ" '←
textFile="SedoriDouyo.htm" '←htmlファイル名
'urlIchiranTop="http://dvdsedori.seesaa.net/article/14002504.html" 'DVDせどり
'nextPageText=2
'nextPageHrefInc="article"
'urlIchiranTop="http://www.oudou.com/cgi/sedori/?" 'せどりの王道
'nextPageText=">>"
'textFile="sedoriOudou.htm"
'urlIchiranTop="http://d.hatena.ne.jp/hissori/" 'ひっそりせどり
'nextPageText="前の5日分"
'textFile="Hixtusorisedori.htm"
'urlIchiranTop="http://d.hatena.ne.jp/noieziel/" 'のいえとせどり
'nextPageText="<前の5日分"
'textFile="NOieToSedori.htm"
'urlIchiranTop="http://arisedori.blog53.fc2.com/" 'ａｒｉの新米せどり日記～初心者みんなでがんばろ～
'nextPageText="次ページ"
'textFile="SedoriAri.htm"
Dim objIE0,url(99),title_m(99),url_rireki(9999)
url_r=0
Dim s
on error resume next
Set Fs = WScript.CreateObject("Scripting.FileSystemObject")
Set oTs1 = Fs.OpenTextFile(textFile,2,true)
'対象画面を検索、なければ開く（必要に応じ使用してください）
Set xShell = CreateObject("Shell.Application")
win_s = False
For Each Window In xShell.Windows '対象URLが表示されているか？
 If TypeName(Window.Document) = "HTMLDocument" Then
  if Window.Document.url=urlIchiranTop then
   Set objIE0 = Window '対象URLが表示→その画面を使う
   win_s=true
   exit for
  end if
 end if
next
if win_s=false then '対象URLが非表示→新しく画面を開く
 Set objIE0 = CreateObject("InternetExplorer.Application")
 objIE0.Visible = True
 objIE0.Navigate urlIchiranTop
 call waitPage(objIE0)
end if
u_no=0
do
 ix=0
 next_url=""
 for i= 0 to objIE0.document.links.Length - 1
  if instr(objIE0.document.links(i).href,"amazon")>0 then
   for j= 0 to url_r -1
    if url_rireki(j)=objIE0.document.links(i).href then exit for
   next
   if j=url_r then
    url(ix)=objIE0.document.links(i).href
    url_rireki(url_r)=url(ix)
    title_m(ix)=objIE0.document.links(i).outertext
    ix=ix+1
    url_r=url_r+1
   end if
  end if
  if next_url="" then
   if nextPageHrefInc<>"" then
    if instr(objIE0.document.links(i).href,nextPageHrefInc)>0 then
     next_url=objIE0.document.links(i).href
    end if
   else
    if isnumeric(nextPageText)=true then
     next_url=objIE0.document.links(nextPageText).href
    else
     if objIE0.document.links(i).outertext=nextPageText then
      next_url=objIE0.document.links(i).href
     end if
    end if
   end if
  end if
 next
 for j=0 to ix-1
  objIE0.Navigate url(j)
  call waitPage(objIE0)
  sk=objIE0.document.body.innerhtml
  title=strmid(sk,"class=sans>","<")
  sk=strmid(sk,"新品/ユーズド価格","")
  used_v=strmid(sk,"￥","<")
  if used_v = "" then
   used_v="0"
  else
   used_v=replace(used_v,",","")
  end if
  sk=objIE0.document.body.innerhtml
  isbn_v=strmid(url(j),"/ASIN/","/")
  if isbn_v="" then
   if instr(sk,"ASIN:")>0 then
    isbn_v=strmid(sk,"ASIN:","&")
    isbn_v=cut_non_num(isbn_v)
   else
    if instr(sk,"ISBN")>0 then
     isbn_v=strmid(sk,"ISBN","&")
     isbn_v=cut_non_num(isbn_v)
    else
     title=title_m(j)
     isbn_v=u_no
     u_no=u_no+1
    end if
   end if
  end if
  if title="" then title=title_m(j)
  oTs1.writeline isbn_v & ",<a href=""" & url(j) & """>" & title & "</a>," & used_v & "<br>"
 next
 if next_url="" then exit do
 objIE0.Navigate next_url
 call waitPage(objIE0)
loop
oTs1.close
Function cut_non_num(s)
 s=replace(s," ","")
 s=replace(s,":","")
 s=replace(s,";","")
 for ii=1 to len(s)
  if isnumeric(mid(s,ii,1)) = false then
   if mid(s,ii,1)>="a" and mid(s,ii,1)<="z" then
   else
    if mid(s,ii,1)>="A" and mid(s,ii,1)<="Z" then
    else
     s=left(s,ii-1)
     exit for
    end if
   end if
  end if
 next
 cut_non_num=s
end function
Function strmid(org,mae,usiro)
 pos = InStr(org, mae)
 If pos > 0 Then
  strmid = Right(org, Len(org) - pos - Len(mae) + 1)
  'org = strmid
  pos = InStr(strmid, usiro)
  If usiro = "" Then
'   strmid = ""
  Else
   If pos > 0 Then
    strmid = Left(strmid, pos - 1)
   End If
  End If
 Else
  strmid = ""
 End If
End Function
Sub waitPage (objIE)
 kan=false
 do while kan=false
        Do While objIE.busy
        Loop
        Do While objIE.Document.readyState <> "complete"
        Loop
  if instr(objIE.Document.body.outertext,"検索中のページは現在、利用できません。Web サイトに技術的な問題が発")=0 then
   kan=true
  else
   objIE.Refresh
  end if
 loop
End Sub

■制限事項（作者が分かっている範囲）
・特にないつもりですが
■免責うんぬん
・本VBSによる使用者の損害どうのこうの補償は作成者は一切関知しません
　使用者の責においてご利用ください
質問・要望はこちらからその他WSH,EXCEL VBAの活用例紹介しています
こちらのオークションでプログラミングの書籍を出品してます