URLからタイトルを取得したい！
エクセルのＡ列にはURLがずらっとあり、Ｂ列にタイトル取得を考えています。
そこで、他の質問者さんのコードを試しました。
その結果、普通のサイトでは問題なく取得できたのですが、
アメーバーブログなどの無料ブログでは、途中で止まってエラーとなってしまうようです。
どこかいけないのでしょうか？
Public Sub ReadTitle()
Dim url As Range
Dim Http, buf As String
Set Http = CreateObject("MSXML2.XMLHTTP")
Set url = Range("A1")
Do While (url.Value <> "")
Http.Open "GET", url.Value, False
Http.Send
buf = StrConv(Http.ResponseBody, vbUnicode)
'msgbox buf
url.Offset(0, 1).Value = getTitle(buf)
Set url = url.Offset(1, 0)
Loop
Set Http = Nothing
End Sub
Private Function getTitle(buf As String) As String
Dim pos1 As Long, pos2 As Long
pos1 = InStr(1, buf, "<title>")
If pos1 = 0 Then
pos1 = InStr(1, buf, "<TITLE>")
If pos1 = 0 Then
getTitle = ""
Exit Function
Else
pos2 = InStr(pos1 + 7, buf, "</TITLE>")
End If
Else
pos2 = InStr(pos1 + 7, buf, "</title>")
End If
getTitle = Mid(buf, pos1 + 7, pos2 - pos1 - 7)
End Function
お礼
ありがとうございます。