エクセルのA列にはURLがずらっとあり、B列にタイトル取得を考えています。
そこで、他の質問者さんのコードを試しました。
その結果、普通のサイトでは問題なく取得できたのですが、
アメーバーブログなどの無料ブログでは、途中で止まってエラーとなってしまうようです。
どこかいけないのでしょうか?


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

このQ&Aに関連する最新のQ&A

A 回答 (1件)

アメブロはUTF-8なので


buf = StrConv(Http.ResponseBody, vbUnicode)
が駄目。

解決策
http://detail.chiebukuro.yahoo.co.jp/qa/question …

この回答への補足

回答ありがとうございます。
今、試してみたのですが、どうも自分では、上手くできません。

申し訳ないのですが、具体的にコードを書いていただけないでしょうか?

よろしくお願いします。

補足日時:2011/04/11 17:13
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aと関連する良く見られている質問

QエクセルでURLからタイトルのみを抽出する方法

URLからタイトルを抽出するマクロについて教えて下さい。
忍者ブログの記事タイトルをURLから抽出しようとしたのですが
文字化けしてしまい全く分かりません。
他のサイトやブログだと普通に抽出出来るのですが・・・
文字コード?か何かだと思うのですが、原因が分かりません。
ちなみに以下のマクロは、ネット上で検索して見つけたものを
そのままコピーして使用しています。

-------------------------------
Public Sub ReadTitle()
Dim url As Range
Dim Http, buf As String

Set Http = CreateObject("MSXML2.XMLHTTP")
Set url = Range("A3")
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
------------------------------

宜しくお願い致します。

URLからタイトルを抽出するマクロについて教えて下さい。
忍者ブログの記事タイトルをURLから抽出しようとしたのですが
文字化けしてしまい全く分かりません。
他のサイトやブログだと普通に抽出出来るのですが・・・
文字コード?か何かだと思うのですが、原因が分かりません。
ちなみに以下のマクロは、ネット上で検索して見つけたものを
そのままコピーして使用しています。

-------------------------------
Public Sub ReadTitle()
Dim url As Range
Dim Http, b...続きを読む

Aベストアンサー

utf-8みたいなので
>buf = StrConv(Http.ResponseBody, vbUnicode)

With CreateObject("ADODB.Stream")
.Open
.Type = 2 'adTypeText
.Charset = "unicode"
.Writetext Http.ResponseBody
.Position = 0
.Charset = "utf-8"
buf = .ReadText()
.Close
End With
にしてみては?


人気Q&Aランキング

おすすめ情報