三流君 ken3のmemo置き場

三流プログラマーのメモ書きです。主にVBAやWindowsの話題が多いです

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。
よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]

またまた、調子こいて回答したけど、、、

http://q.hatena.ne.jp/1251504373
の質問に、
またまた、調子に乗って回答したけど、
なんか、うまくソースを貼れなかった。
<pre>と</pre> で囲ったんだけど、、、

日記に同じように <pre>と</pre> でソースをはると、


Sub Link情報を取得する()
'次へのボタンを押す。

Dim objIE As Object
Dim strURL As String
Dim strNEXT As String '次に表示するURL
Dim i As Integer
Dim nYLINE As Integer

'IEのオブジェクトを作成する
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True

'初期ページを代入
strNEXT = "http://okwave.jp/212/423/c450.html" 'URL代入
nYLINE = 10 '10行目からせっとするので

While strNEXT <> "" '次のURLが入っている間まわる
'ページを開く(.Navigateで表示する。)
objIE.Navigate strNEXT 'アドレスを渡し表示する

'読み込み完了となるまで、ループする。
While objIE.ReadyState <> 4 Or objIE.Busy
DoEvents
Wend
'↑これだと、広告画像の表示を待つから、クールじゃないなぁ。
'

'リンクを探す
'リンク数分まわす A列にアンカーテキスト B列にURLを書く
strNEXT = "" '次のURLを初期化
'上の次へがくるまで、空読み。
For i = 0 To objIE.Document.Links.Length - 1
'次へが見つかったら、抜ける※ここから下に質問があるので、、、、
If Left(objIE.Document.Links(i).innerText, 2) = "次へ" Then 'テキストが 次へ
strNEXT = objIE.Document.Links(i).href 'URL(次へ)を代入
Exit For 'ループを抜ける
End If
'↑あっ、これだと、最後のページが取れないか、、、
Next i
For i = i + 1 To objIE.Document.Links.Length - 1
'セット条件を http://okwave.jp/qa があるか?にする。
If Left(objIE.Document.Links(i).href, 19) = "http://okwave.jp/qa" Then
Cells(nYLINE, "A") = "'" & objIE.Document.Links(i).innerText 'テキスト
Cells(nYLINE, "B") = objIE.Document.Links(i).href 'URL
nYLINE = nYLINE + 1 'セット位置を+1する
End If

'2回目の次へが見つかったら、強制的に抜ける※2回目の次へは質問よりしたなので、、
If Left(objIE.Document.Links(i).innerText, 2) = "次へ" Then 'テキストが 次へ
Exit For 'ループを抜ける
End If
Next i
Cells(nYLINE, "A").Select '普通イラナイケド、進行状況見たいので、、、
Wend

objIE.Quit 'IEを閉じる

End Sub

少しは、まともになるのかなぁ??
まぁ、ソースの見た目がよくなっても、問題点はそのままだから、、、

最後のページは、まぁ、置いておいても、
新規投稿があったときに、データがズレてしまうのは、いただけないよね。
※最後に重複取ったり、次ページの頭のデータが前ページにあるか見ないとね。
 まぁ、そのあたりは、うまくアレンジしてもらえるかなぁ・・・・

追伸: コメントランで便利な方法を教えていただきました。感謝ですね。
http://hatenadiary.g.hatena.ne.jp/keyword/ソースコードを色付けして記述する(シンタックス・ハイライト)
↑忘れないように、リンクを貼っておこう。次から、これ、つかうぞ。

※※回答を書き直せないのがイタイですね、、、
下記、
>|vb|
今回のソース

<

で貼ってみた。

Sub Link情報を取得する()
    '次へのボタンを押す。

    Dim objIE     As Object
    Dim strURL    As String
    Dim strNEXT   As String  '次に表示するURL
    Dim i         As Integer
    Dim nYLINE As Integer

    'IEのオブジェクトを作成する
    Set objIE = CreateObject("InternetExplorer.application")
    objIE.Visible = True
    
    '初期ページを代入
    strNEXT = "http://okwave.jp/212/423/c450.html"        'URL代入
    nYLINE = 10  '10行目からせっとするので
    
    While strNEXT <> ""   '次のURLが入っている間まわる
        'ページを開く(.Navigateで表示する。)
        objIE.Navigate strNEXT  'アドレスを渡し表示する
    
        '読み込み完了となるまで、ループする。
        While objIE.ReadyState <> 4 Or objIE.Busy
            DoEvents
        Wend
        '↑これだと、広告画像の表示を待つから、クールじゃないなぁ。
        '

        'リンクを探す
        'リンク数分まわす A列にアンカーテキスト B列にURLを書く
        strNEXT = ""  '次のURLを初期化
        '上の次へがくるまで、空読み。
        For i = 0 To objIE.Document.Links.Length - 1
            '次へが見つかったら、抜ける※ここから下に質問があるので、、、、
            If Left(objIE.Document.Links(i).innerText, 2) = "次へ" Then 'テキストが 次へ
                strNEXT = objIE.Document.Links(i).href     'URL(次へ)を代入
                Exit For  'ループを抜ける
            End If
            '↑あっ、これだと、最後のページが取れないか、、、
        Next i
        For i = i + 1 To objIE.Document.Links.Length - 1
            'セット条件を http://okwave.jp/qa があるか?にする。
            If Left(objIE.Document.Links(i).href, 19) = "http://okwave.jp/qa" Then
                Cells(nYLINE, "A") = "'" & objIE.Document.Links(i).innerText 'テキスト
                Cells(nYLINE, "B") = objIE.Document.Links(i).href      'URL
                nYLINE = nYLINE + 1 'セット位置を+1する
            End If
            
            '2回目の次へが見つかったら、強制的に抜ける※2回目の次へは質問よりしたなので、、
            If Left(objIE.Document.Links(i).innerText, 2) = "次へ" Then  'テキストが 次へ
                Exit For  'ループを抜ける
            End If
        Next i
        Cells(nYLINE, "A").Select '普通イラナイケド、進行状況見たいので、、、
    Wend
    
    objIE.Quit   'IEを閉じる

End Sub

↑キレイで見やすいですね。※※※同じバグ付きのソースだけど、馬子にも衣装?
これから
>|vb|
vbaソース

<

使わないとなぁ。

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。
・[Excel/Access VBA]の解説
・[ASP(Active Server Pages)]の解説。
・[元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
・[プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
三流君を踏み台にする
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



Googleを使用して検索する

読者の声:三流君の説明・解説じゃ よくわからなかったから、Googleを使って、自分で検索します。
三流君:残念です。あっ、下記にGoogleの検索窓を設置しました。
いろいろ指定して試してみてください。

Google
探す言葉:気になる単語や,オブジェクト(Document),プロパティ(.Busy)やメソッド(.Navigate)などを入れて検索してみてください。


言語を指定:見つからない時は指定無しで探す

サイト指定:人気QAサイト や 一次情報MS本家を指定する
一次情報・二次情報まとめから探る
QAサイトの質問から探る
検索実行: ←オプション確認後に検索ボタンを押してください

期間指定:情報の鮮度も大切?
検索実行: ←オプション確認後に検索ボタンを押してください


本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)