サイトタイトルに、指定した語句があれば○
下記のマクロは、指定範囲のURL先のソースに、
指定した語句があれば、○を付けるマクロです。
指定した語句をソース全て対象にせずに、
<title></title>のサイトタイトルの中にあれば、○を付けるというようにしたいです。
ちなみに、調べたいのは語句ではないですが、"【"というカッコです。
・下記のマクロ
URL先のソース全体の中に、指定した語句があれば○
・希望のマクロ
<title></title>（サイトタイトル）の中に、指定した語句があれば○
どの部分を修正、または追加すればできるようになりますか？
よろしくお願いいたします。
Sub 指定した語句()
'!!!! [Microsoft XML v6.0] に参照設定すること
Dim xHttp As IServerXMLHTTPRequest
Dim myErr_Number As Long, myErr_Description As String
Set xHttp = CreateObject("MSXML2.ServerXMLHTTP")
Dim aCell As Range
R = 1
For Each aCell In Selection.Columns(1).Cells '選択セルの1列目がURL
Application.Goto aCell '対象URLの列にジャンプ表示
DoEvents
sUrl = aCell.Value
If sUrl <> "" Then
xHttp.Open "GET", sUrl, True
xHttp.setOption SXH_OPTION_IGNORE_SERVER_SSL_CERT_ERROR_FLAGS, _
SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS ' SSL関係のエラーを無視
On Error Resume Next
xHttp.send
If xHttp.readyState <> 4 Then
xHttp.waitForResponse 5 '5秒まってだめならタイムアウト
End If
If xHttp.readyState <> 4 Then Err.Raise 1004, , "タイムアウト"
myErr_Number = Err.Number
myErr_Description = Err.Description
On Error GoTo 0
If myErr_Number = 0 Then
sHtml = xHttp.responseText
nRtn = InStr(sHtml, "指定した語句")
If nRtn = 0 Then
aCell.Offset(, 1).Value = "--"
Else
aCell.Offset(, 1).Value = "○"
End If
Else
aCell.Offset(, 1).Value = myErr_Description ' エラー時はエラー内容を表示
End If
DoEvents
End If
Next
Set xHttp = Nothing
End Sub
お礼
回答ありがとうございました！ 問題の意味すら分からなかったので、 とても助かりました！