こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

OKwaveの管理をvbaで行なっているのですが

VBAで最終的に、カテゴリの「214/905/c906.html」を取得したいのですが
どういうコードを作ればいいのでしょうか?

Sub Sample()
Dim mystr As String

mystr = "<li><a href=""/c214.html"">ライフ</a>&nbsp;&gt;</li><li><a href=""/214/c905.html"">出産・育児</a>&nbsp;&gt;</li><li><a href=""/214/905/c906.html"">育児</a>&nbsp;</li>"""

End Sub

私としては「a href=""」より右をMidかRightで取得しようと思うのですが
このカテゴリーだと「a href=""」は3つあり、
一番最後の「a href=""」もしくは
左からではなく、右からみて一番最初の「a href=""」を取得するにはどうすればいいでしょうか?

一番左の「a href=""」なら

Sub Sample()
Dim mystr As String

mystr = "<li><a href=""/c214.html"">ライフ</a>&nbsp;&gt;</li><li><a href=""/214/c905.html"">出産・育児</a>&nbsp;&gt;</li><li><a href=""/214/905/c906.html"">育児</a>&nbsp;</li>"""

intStart = InStr(1, mystr, "a href=""")
mystr = Mid(mystr, intStart)

End Sub

なら行けるのですが、一番右を取得する方法、
もしくはもっと効率の良い方法があれば教えてください。

投稿日時 - 2016-05-22 21:14:36

QNo.9176572

暇なときに回答ください

質問者が選んだベストアンサー

3つだって分かってるなら、IsStr関数を3回使うとか。

intFirst = InStr(1, mystr, "a href=""") ' 最初の
intSecond = InStr(intFirst+1, mystr, "a href=""") ' 2番目の
intStart = InStr(intSecond+1, mystr, "a href=""") ' 3番目の


あるいは、右から検索するなら、InStrRrv関数を使用とか。

intStart = InStrRev(mystr, "a href=""")

InStrRev 関数 (Visual Basic)
https://msdn.microsoft.com/ja-jp/library/t2ekk41a(v=vs.90).aspx

投稿日時 - 2016-05-22 21:37:45

お礼

回答ありがとうございました。

投稿日時 - 2016-05-26 22:54:08

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

-広告-
-広告-

回答(4)

ANo.4

' 前の投稿(No.3)の続きです。
 ' // 質問ページデータ取得 / 実行マクロ
Sub ReW9176572()

Dim oIE As Object ' As SHDocVw.InternetExplorer ' (最初に開いたIEウィンドウの)最後に表示していたIEタブ取得
 ' oIE As SHDocVw.IWebBrowser2 → As SHDocVw.InternetExplorer
 If FindActiveIExpr(oIE) = False Then MsgBox "IEがActiveじゃないよ!": Exit Sub

Dim sURLq As String ' 【QAページのURL】
 sURLq = oIE.LocationURL
Debug.? sURLq

 If Not sURLq Like "http://bekkoame.okwave.jp/qa##*##.html*" Then ' ▽URLチェック
  MsgBox "'bekkoame.okwave'のQAページをIEに表示してから再実行"
  Set oIE = Nothing
  Exit Sub
 End If

Dim oDoc As Object ' As MSHTML.HTMLDocument
Dim colElm As Object ' As MSHTML.IHTMLElementCollection
Dim oDiv As Object ' As MSHTML.HTMLDivElement
 Set oDoc = oIE.document
 Set oIE = Nothing

 ' <ul class="bread">
 ' <li><a href="/">Bekk...</a>...</li>
 ' <li><a href="/c214...</a>...</li>
 ' <li><a href="/214/c905...</a>...</li>
 ' <li><a href="【/214/905/c906.html】">育児</a>...</li>
 ' </ul>
''▽
 ' > ..カテゴリの「214/905/c906.html」を取得..
Dim sCatPath As String ' 【カテゴリ パス】
 Set colElm = oDoc.getElementsByClassName("bread")
 With colElm(0).Children
  sCatPath = .Item(.Length - 1).FirstChild.pathname ' ★最後の要素★のパス
 End With
Debug.? sCatPath,

 ' <input type=... id="transfer_url" name=... value="【/qa#######.html】">
''▽
Dim sQaPath As String ' 【QAパス】
 Set oDiv = oDoc.getElementById("transfer_url")
 sQaPath = oDiv.Value
Debug.? sQaPath,

 ' <input type=... id="qid" value="【#######】" />
''▽
Dim nQaId As Long ' 【QA番号(ID)】
 Set oDiv = oDoc.getElementById("qid")
 nQaId = Val(oDiv.Value)
Debug.? nQaId

 ' <p class=... id="question_title">【QAタイトル】</p>
 ' <p class="datail_tex qa_tex"><span id="question">【Q本文(行1)】<br />
 ' 【Q本文(行2)】<br />
 ' 【...】
 ' 【Q本文(最終行)】</span></p>
 ' <p>投稿日時 - 【yyyy-mm-dd hh:mm:ss】</p>
''▽▽▽
Dim sQaTitle As String ' 【QAタイトル】
 Set oDiv = oDoc.getElementById("question_title")
 sQaTitle = oDiv.innerText
Debug.? "◆"; sQaTitle

Dim sQTxt As String ' 【Q本文】
 Set oDiv = oDoc.getElementById("question")
 sQTxt = oDiv.innerText
Debug.? sQTxt

Dim dtQPost As Date ' 【Q投稿日時】
 dtQPost = Replace(oDiv.ParentNode.NextSibling.NextSibling.innerText, "投稿日時 - ", "")
Debug.? dtQPost,

 ' <div class="ico_qLevel_box_favusr flo_l"><div class="ico_q_level_0#_?"></div></div>
 ' <p class="font_siz_10 tx_align_c">【暇なときに回答ください|困ってます|すぐに回答ほしいです】</p>
''▽
Dim sQLev As String ' 【Qレベル】
 Set colElm = oDoc.getElementsByClassName("ico_qLevel_box_favusr flo_l")
 sQLev = colElm(0).NextSibling.NextSibling.innerText
Debug.? sQLev,

 ' <div class="ok_lq_detail_ttl flo_l">
 '  <div class="ico_question_l"></div>
 '  <h2>【回答受付中の質問|解決済みの質問|締切り済みの質問】</h2>
 ' </div>
''▽
Dim sQSts As String ' 【Qステータス】
 Set colElm = oDoc.getElementsByClassName("ico_question_l")
 sQSts = colElm(0).NextSibling.innerText
Debug.? sQSts,

 ' <a id="fav_qa" href="...">お気に入りに登録</a><span id="fav_qa_span">(<font id="fav_qa_count">【#】</font>)</span>
''▽
Dim nQaFav As Long ' 【QAお気に入り】
 Set oDiv = oDoc.getElementById("fav_qa_count")
 nQaFav = Val(oDiv.innerText)
Debug.? nQaFav,

 '  <b id="sum_instructive" class="color_FFCC00">【#】</b>
 '  人が「このQ&amp;Aが役に立った」と投票しています
''▽
Dim nQaInstr As Long ' 【QA役に立った】
 Set oDiv = oDoc.getElementById("sum_instructive")
 nQaInstr = Val(oDiv.innerText)
Debug.? nQaInstr

 ' <div class="ok_lq_detail_l">|<div class="ok_lq_bestA_detail_l">|<div class="ok_lq_answer_l">
 '  ...
 '  <div class="tx_align_c">
 '  <p><a href="【user.php3?u=#######】">【ユーザー名】</a></p>
 '  </div>
 '  ...
 ' </div>
''▽▽
Dim sUserName As String ' 【ユーザー名】
Dim sUserPath As String ' 【ユーザーパス】
 Set colElm = oDoc.getElementsByClassName("tx_align_c") ' 質問者/回答者 全 名前 相対パス
Debug.? "質問者:",
 For Each oDiv In colElm
  If oDiv.tagName = "DIV" Then
   sUserName = Trim$(oDiv.innerText) ' 質問者/BA回答者/回答者 全 名前
Debug.? sUserName,
   On Error Resume Next
   sUserPath = "/" & oDiv.Children(0).FirstChild.nameProp ' 質問者/回答者 全 相対パス
   If Err Then
Debug.? "●BA●",
    sUserPath = "/" & oDiv.Children(0).FirstChild.NextSibling.nameProp ' BA回答者 相対パス
   End If
Debug.? sUserPath
   On Error GoTo 0
  End If
 Next

End Sub

 ' //

投稿日時 - 2016-05-23 21:08:26

お礼

回答ありがとうございました。

投稿日時 - 2016-05-26 22:53:58

ANo.3

こんにちは。お邪魔します。

> OKwaveの管理をvbaで行なっているのですが
> もしくはもっと効率の良い方法があれば教えてください。

VBAでHTMLテキスト取得(&部分切り分け)が出来ているのでしたら、
正規表現 VBScript.RegExp(VBScript_RegExp_55.RegExp)
で『マッチした最後のもの』を抽出出来ます。
> VBAで最終的に、カテゴリの「214/905/c906.html」を取得したいのですが
 Set oRegExp = CreateObject("VBScript.RegExp")
 With oRegExp
  .Global = True
  .IgnoreCase = True
  .Pattern = "<a href=\""*([^>\""]+)\""*"
 End With
 Set colMatch = oRegExp.Execute(myStr)
 myRet = colMatch(colMatch.Count - 1).SubMatches(0)
でも、文字列の並びに頼って処理する場合は(Instrも同じ)、
ページデザインのちょっとしたマイナーチェンジにも
都度都度対策が必要になったりして(私も本家OKWAVEで何度も苦労しました)
後々不安は残ります。
そもそも、
> このカテゴリーだと「a href=""」は3つあり、
<a href= ... が3つしか無い部分を抜き出す処理を済ませてある前提ですよね?
実際はもっと数多くあるし、ページによって増減する可能性も否定できませんし、、、。
となると、その抜き出し方次第、、、ではあります。

bekkoame.okwaveのQAページをInternetExprolerで開いている、
ということのようですから(←添付画像を見ての判断)、
そのまま、HtmlDocumentに対してDOMで処理するのが普通のやり方かな、と。

データ採りしたいQAページを表示した状態から実行するマクロ(DOM版)を、
  次の投稿に掲げます。

(最初に開いたIEウィンドウの)最後に表示していたIEタブを取得 する関数を
  この投稿の下部に掲げます。

文字数制限の関係で、2つの投稿に分けますが、
普通に標準モジュールに2つ並べて貰って、
次の投稿にある / 実行マクロ を実行してみて下さい。

DOM操作に慣れることを意図して、幾つかのデータを取得する例を挙げてみます。
 Htmlソースを併記して
  .getElementsByClassName
  .getElementById
 だけで検索するように(解り易さ優先の練習教材として)統一しています。
ソースを読む場合は、
 IE [ページ] → [ソースの表示] または [表示] → [ソース]

 IE [ツール] → [F12 開発ツール] または F12キー
 の
  [DOM Explorer] や [デバッガー]
を活用して、
VBAで要素への参照に迷った時は、
 VBE ステップ実行(F8キー や ブレークポイント等)

 VBE [ローカルウィンドウ]
を組み合わせて、求める属性を指すプロパティを探してみて下さい。
基本的な技術情報等は、
 VBA IE HTMLDocument getElementsByClassName getElementById
などのキーワードでWeb検索をどうぞ。

因みにこの回答も、VBAで取り込んだ質問ページデータを基に状況を確認して、
解答案作成や検証にも活用しています。
以前は私もbekkoame.okwaveさんから資料を採らせて頂いていましたが、
広告なしの運営で、且、運営側に販促的な価値を求める様子もないことから、
標準的な利用以外は控えようという意見が多くなっていた時期もありました。
(ここ数年、本家はリニューアルしても追随していないこともあり、
 もう、あまりコストをかけたくないのかなぁとか?まだ続くのかなぁ?とか)
たぶん、、、本家OKWAVEとは違い、アクセス(閲覧)数が増えることが
利益に繋がることのない(維持管理コストばかりの)運営なのでしょう。
現に閲覧しているページのデータを採ることには問題はないだろう、という
考えで、VBAによるデータ取得のサンプルをあげますが、
私個人としては、目的の為にわざわざアクセスするような使い方は
勧めるつもりはありませんので、その点ご理解ください。

 ' // (最初に開いたIEウィンドウの)最後に表示していたIEタブ取得

Function FindActiveIExpr(ByRef oIE As Object) As Boolean ' oIE As SHDocVw.InternetExplorer
Dim oShell As Object ' As Shell32.Shell
Dim oExpr As Object ' As SHDocVw.IWebBrowser2
Dim sStB0 As String ' 各IEタブの.StatusText:既定の値
Dim sStB As String ' 各IEタブの.StatusText:最後に表示していたかチェックする為のダミーの値
Dim blnStB As Boolean

 Set oShell = CreateObject("Shell.Application")
 DoEvents
 For Each oExpr In oShell.Windows
  If TypeName(oExpr.document) = "HTMLDocument" Then
   blnStB = oExpr.StatusBar
   If Not blnStB Then oExpr.StatusBar = True
   sStB0 = oExpr.StatusText
   sStB = CStr(Date & " " & Timer())
   oExpr.StatusText = sStB
   If oExpr.StatusText = sStB Then
    oExpr.StatusText = sStB0
    If Not blnStB Then oExpr.StatusBar = False
    Exit For
   End If
   If Not blnStB Then oExpr.StatusBar = False
  End If
 Next
 If oExpr Is Nothing Then Exit Function
 Set oIE = oExpr
 Set oShell = Nothing: Set oExpr = Nothing
 FindActiveIExpr = True
End Function

 ' //

' 次の投稿へ続きます。

投稿日時 - 2016-05-23 21:03:03

お礼

回答ありがとうございました。

投稿日時 - 2016-05-26 22:54:02

ANo.2

>カテゴリの「214/905/c906.html」を取得した
参考に
Dim mystr As String, mystr2 As String, mystr3 As String
Dim arrStr As Variant

mystr = "<li><a href=""/c214.html"">ライフ</a>&nbsp;&gt;</li><li><a href=""/214/c905.html"">出産・育児</a>&nbsp;&gt;</li><li><a href=""/214/905/c906.html"">育児</a>&nbsp;</li>"""
arrStr = Split(mystr, "a href=""/")
mystr2 = arrStr(UBound(arrStr) - 1)
MsgBox mystr2
mystr3 = Split(mystr2, """>")(0)
MsgBox mystr3

投稿日時 - 2016-05-23 16:03:24

お礼

回答ありがとうございました。

投稿日時 - 2016-05-26 22:54:05

-広告-
-広告-

あなたにオススメの質問

-広告-
-広告-