プロが教えるわが家の防犯対策術!

エクセル内のA列にURLがあるのですが、B列にそのURLのHPのタイトルだけを抽出する方法はありますか?
色々調べて
------------------------------------------
Public Sub ReadTitle()
Dim IE
Dim url As Range
Dim i As Integer

Set url = Range("A2")
Set IE = CreateObject("InternetExplorer.Application")

i = 0
Do While (url.Offset(i, 0).Value <> "")
IE.Navigate (url.Offset(i, 0).Value)
While IE.busy: Wend
While IE.Document.readyState <> "complete": Wend
url.Offset(i, 1).Value = IE.Document.Title
url.Offset(i, 3).Value = url.Offset(i, 2).Value '前回日付
url.Offset(i, 2).Value = IE.Document.LastModified
i = i + 1
Loop
End Sub

このようなマクロで抽出は出来たのですが、URLは1万件以上あり、PCのスペックの低さのせいか、何時間もかかってしまいます。

もっと早く、タイトルだけを抽出する方法は無いでしょうか?
よろしくお願いします。

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

A 回答 (4件)

>自分はとんでもなく無謀な事をしているような気になってきました。


まだ、初めの0.1歩くらいしか踏み出していませんよ。
VBEにはヘルプというものがありますので、Instrって何?と思ったら、検索してみてください。「使用例」の方をみてみると、およその様子が分かります。
下記にコードを載せます。'msgbox bufのところのシングルクォーテーションを外すと、何が起こっているか分かると思います。
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
htmlがシフトJISか、UNICODEかで分岐しないといけないと記してある記事もありますので、URLによって変なエラーが出る場合は参考URLをご覧下さい。

参考URL:http://www.f3.dion.ne.jp/~element/msaccess/AcTip …
    • good
    • 0
この回答へのお礼

出来ました!!
本当にありがとうございました(T_T)
面倒な質問者でご迷惑をおかけしました、ありがとうございます!

お礼日時:2008/09/09 22:41

>Sample = ........の部分に赤字でエラーが出るのですが、ここには何を入れるのでしょうか?


ここは自分で書いてねという事なので、エラーが出て当たり前です。
文字列変数bufに、htmlが丸ごと入ります。Instr関数で、<title>??????</title>の、<title>と、</title>それぞれの位置を求め、Mid関数で、??????の部分を取得してはいかがですか、という意味です。今日はもう寝ます。
    • good
    • 0
この回答へのお礼

自分はとんでもなく無謀な事をしているような気になってきました。
何度もすみません、先ほども言った様にまるで知識がないのですが、Sample=の後にhtmlを入れると構文エラーと出て
Private Function Sample(url As String) As String
の部分が黄色くなります。
文字列変数bufやInstr関数というのも、どこを指すのか解からないのです。
ちなみに、htmlを入れる場所には、タイトルを抽出したいURLが1万件あれば、1万件入力すると言う事でしょうか?
お時間があるときで結構ですのでよろしくお願いします。

お礼日時:2008/09/09 01:31

>これだと1件1件の手作業になってしまいます。


質問文のコードを書ける方のコメントとも思えませんが、下記の様にやれば良いのではないでしょうか。ソース中の<title>?????</title>の部分を見つけるのは、正規表現を持ち出すまでもなく、Instr関数で十分だと思います。便宜上、関数を呼び出す度に、CreateObject("MSXML2.XMLHTTP")~解放を行っていますが、ループの最初だけで行い、最後に解放する様にした方が速度上有利だと思います。
Public Sub ReadTitle()
Dim url As Range
Dim i As Integer

Set url = Range("A2")
i = 0
Do While (url.Offset(i, 0).Value <> "")
url.Offset(i, 1).Value = Sample(url.Offset(i, 0).Value)
i = i + 1
Loop
End Sub

Private Function Sample(url As String) As String
Dim Http, buf As String
Set Http = CreateObject("MSXML2.XMLHTTP")
Http.Open "GET", url, False
Http.Send
buf = StrConv(Http.ResponseBody, vbUnicode)
'ここで、buf中の<title>??????</title>を見つけ、戻り値として返す
Sample = ........
Set Http = Nothing
End Function
    • good
    • 0
この回答へのお礼

説明不足でした。。。
質問のマクロは方法を探していたときにたまたま発見したもので、私自信は全く知識はありません。
mitarashi様が記載して頂いたマクロも貼り付けてみたのですが、エラーがでてしまい、どこがどうなのかイマイチ理解はしておりません。
Sample = ........
の部分に赤字でエラーが出るのですが、ここには何を入れるのでしょうか?

お礼日時:2008/09/09 00:20

htmlをダウンロードして、テキストとして処理してはいかがでしょうか。



参考URL:http://officetanaka.net/other/extra/tips02.htm
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
参考URLを参考にし、やってみたのですがいまいちうまく行きません。
ソースをとるマクロのようですが、これだと1件1件の手作業になってしまいます。
なるべく早い時間で、タイトルだけを抜き出したいのです。
難しいのかもしれませんが、引き続きよろしくお願いします。

お礼日時:2008/09/08 10:55

このQ&Aに関連する人気のQ&A

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

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

この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
にしてみては?

Qlink先のURLとタイトル一覧の取得方法

例えばlink集のようなページがあり、そこに掲載のlink先のURLと、そのタイトル(titleタグ)を簡単に一覧で取得するツールやブラウザのアドオンなどあれば教えてください。

Aベストアンサー

link集のようなページをコピーしてエクセルに貼り付け、次のユーザー定義関数を使ってみてください。

エクセルのハイパーリンク先のURLを取得するユーザー定義関数

数式で設定しているものを除きます。
ファイルやドキュメント内リンクも除きます。
URLは、最初に設定しているhttpから始まっているものを返します。
A1セルに設定しているハイパーリンクのURLを表示するには、以下の式を使います。

= GetURL(A1)

設定方法は、
1.Alt + F11 で VBE(Visual Basic Editor)を開きます。
2.VBE のメニューから[挿入] -->[標準モジュール] を指定します。
3.コードウィンドウに下記コードをコピーして貼り付けます。
4.右上隅の×でウィンドウを閉じ、シートに戻ります。
5.メニューから[開発]の[マクロのセキュリティ]の、
「マクロの設定」で「警告を表示してすべてのマクロを有効にする」、
 「開発者向けのマクロ設定」で「VBAプロジェクト オブジェクト モデルへのアクセスを信頼する」にチェックを入れてOKをクリックする。

これで、GetURL関数が使用できる状態になります。

Function GetURL(Rng As Range) As String
Dim Adr As String
If Rng.Hyperlinks.Count > 0 Then
With Rng.Hyperlinks(1)
If .Address Like "http*" Then
Adr = .Address
End If
End With
End If
If Adr <> "" Then
GetURL = Adr
Else
GetURL = ""
End If
End Function

link集のようなページをコピーしてエクセルに貼り付け、次のユーザー定義関数を使ってみてください。

エクセルのハイパーリンク先のURLを取得するユーザー定義関数

数式で設定しているものを除きます。
ファイルやドキュメント内リンクも除きます。
URLは、最初に設定しているhttpから始まっているものを返します。
A1セルに設定しているハイパーリンクのURLを表示するには、以下の式を使います。

= GetURL(A1)

設定方法は、
1.Alt + F11 で VBE(Visual Basic Editor)を開きます。
2.VBE のメニューから...続きを読む

QVBAでHTMLのtitleタグの中身を抽出してA1に入れたい

VBAでHTMLのtitleタグの中身を抽出してA1に
入れるにはどうすればよいのでしょうか?

例:<title>Yahoo! JAPAN</title>のYahoo! JAPANをA1に入れる

使用OS:Windows XP
使用ソフト:Microsoft Excel 2003

ご存知の方がおられましたらご回答をよろしくお願いします。

Aベストアンサー

下記のコードでWin2000&Excel2002では、正常にTitleが取得できました。

'=============================================================
Sub main()
  Dim IE
  Set IE = CreateObject("InternetExplorer.Application")
  With IE
   .Visible = True
   .navigate "http://www.yahoo.co.jp/"
   Do While .Busy = True Or .readyState <> 4
     Loop
   Range("a1").Value = .document.Title
   .Quit
   End With
  Set IE = Nothing
End Sub

QVBAを使ってHTMLソースから特定の文字列を抽出したいと思っています

VBAを使ってHTMLソースから特定の文字列を抽出したいと思っています。
正規表現を利用してタグに挟まれた文字を抽出したいのですがうまくいきません。
タグごと抽出する方法でも構わないので教えてください。

例えば
<a href="www.yahoo.com△">○○○</a>   ・・・<1>
※△は(www.yahoo.com)+(半角数字1文字)
※○○○は1文字以上の全角文字

このようなパターンの文字列(<1>を丸ごと)を抜き出すには
どのような正規表現を書けばよいでしょうか?
単に<a href ではじまって </a>  で終わる文字列であれば
<a href.*</a>
で良いと思うのですが、もう少し範囲を絞れば目的の文字列だけを抽出できるので
ぜひ実現させたいと思っています。宜しくお願いします。

Aベストアンサー

 正規表現による抽出にこだわらないでしたら、
>例えば
の答えは、[Links プロパティ] により、 下記のような方法で
>タグごと抽出する
こともできますし、
>もう少し範囲を絞れば目的の文字列だけを抽出
することもできます。

Sub test()
 Dim objIE As Object
 Dim i As Long
 Set objIE = CreateObject("InternetExplorer.Application")
 With objIE
  .navigate "http://www.yahoo.com/"
  While .Busy Or .ReadyState <> 4: DoEvents: Wend
  With .Document
   For i = 0 To .Links.Length - 1
    Cells(i + 1, 1) = .Links(i).outerHTML
    Cells(i + 1, 2) = .Links(i).outerText
   Next
  End With
 End With
 objIE.Quit
 Set objIE = Nothing
End Sub

 正規表現による抽出にこだわらないでしたら、
>例えば
の答えは、[Links プロパティ] により、 下記のような方法で
>タグごと抽出する
こともできますし、
>もう少し範囲を絞れば目的の文字列だけを抽出
することもできます。

Sub test()
 Dim objIE As Object
 Dim i As Long
 Set objIE = CreateObject("InternetExplorer.Application")
 With objIE
  .navigate "http://www.yahoo.com/"
  While .Busy Or .ReadyState <> 4: DoEvents: Wend
  With .Document
   For i = 0 To .Links.Lengt...続きを読む

QエクセルでハイパーリンクのURLだけを文字抽出したい

ホームページからコピーし、エクセルにリンク文字をペーストすると、青文字(文字にハイパーリンクがかかった状態)が貼りつきます。その張り付いた文字の、リンク先URLを文字としてほしい(http○○・・)のですが、できますか?
青文字を右クリックしてハイパーリンクの編集からURLは見られるのですが、たくさんのリンクリストからURLだけを抽出するのが大変なので、よい方法がありましたらお願いします。

Aベストアンサー

No3 です。
サブアドレスの存在を忘れていました。
訂正です。

Public Sub GetURL()
  Dim h As Hyperlink
  Dim a As String
  Dim s As String
  For Each h In ActiveSheet.Hyperlinks
    a = h.Address
    s = h.SubAddress
    If s <> "" Then
      a = a & "#" & s
    End If
    h.Range.Offset(0, 1) = a
  Next
End Sub

Q[VBA]WEBページのリンク先情報の取得

こちらの識者の方々にはいつもお世話になっています。
VBAの質問です。

環境は下記になります。
OS=windowsXP SP3
Office=Excel2003(11.8347.8403) SP3

WEBページからリンクをたどって必要な情報をExcelのシートに書き出していきたいのですが、やり方がわからず困っています。

http://www.dmm.com/rental/monthly/
のホームページを開き、ExcelのA列に商品の型番が入っているので、その文字列で検索し、商品のリンクをクリックし、DVDのタイトルをB列に、貸出開始日をC列に、出演者をD列に書き出していきたいのです。

例としては、A1に"r55113r"という文字列があり、この文字列で検索すると、"007/スカイフォール"の商品リンクが出てくるのですが、ブルーレイ版とDVD版があり、 タイトルに"(ブルーレイディスク)"のついていない方のリンクを開き、
B1セルに”007/スカイフォール” '作品タイトル
C1セルに”2013.04.03” '貸出開始日(yyyy.mm.dd形式)
D1セルに”ダニエル・クレイグ レイフ・ファインズ ジュディ・デンチ ナオミ・ハリス ベレニス・マーロウ ベン・ウィショー ハビエル・バルデム” '出演者
を書き出す。
以下A2セル以降同様。という感じです。

おそらくないと思うのですが、ブルーレイ版と通常版以外のものがあった場合は、その作品についてはデータを書き出さなくても大丈夫です。

以下が、途中まで作ったコードです。

Sub ie_test()

Dim objIE As Object
Dim strURL As String

Set objIE = CreateObject("InternetExplorer.application")
strURL = "http://www.dmm.com/rental/monthly/"
With objIE
.Visible = True
.Navigate strURL
waitNavigation objIE
.document.all.searchstr.Value = "r55113r"
.document.Forms(1).submit
End With

MsgBox "done"

End Sub


Sub waitNavigation(objIE As Object)
Do While objIE.Busy Or objIE.ReadyState < 4
DoEvents
Loop
End Sub

これで、検索するところまでは行けたのですが、その後の処理ができなくて困っています。
.document.all.searchstr.Value = "r55113r"
については、コードが完成してから For Next文で回そうと思っていたので、とりあえずベタで入れています。

上記のような処理をしたい場合、どのようなコードが適していますでしょうか。
識者の皆様ご教示のほど、よろしくお願いいたしますm(_ _)m

こちらの識者の方々にはいつもお世話になっています。
VBAの質問です。

環境は下記になります。
OS=windowsXP SP3
Office=Excel2003(11.8347.8403) SP3

WEBページからリンクをたどって必要な情報をExcelのシートに書き出していきたいのですが、やり方がわからず困っています。

http://www.dmm.com/rental/monthly/
のホームページを開き、ExcelのA列に商品の型番が入っているので、その文字列で検索し、商品のリンクをクリックし、DVDのタイトルをB列に、貸出開始日をC列に、出演者をD列に書き出していきたいの...続きを読む

Aベストアンサー

リンク先のサイトは質問を読んで初めて使いましたので、完璧に質問者様の望む回答は出来ないと思いますが、参考程度になればと思い回答させて頂きました。

また質問者様のOSはXPとのことですので、IEのバージョンは8かそれ以前かと思われますが、VBAでIE操作の処理をしたい場合はIE9があれば8に比べてだいぶ楽に書けるかと思います。
今回の回答では8でも動作できるように、のつもりで書きましたが、あくまで動作確認は9で行っているため、もし動かなかったらごめんなさいm(_ _)m

まず、検索結果から通常版へのリンクのクリックですが、検索結果の通常版へのリンクのURLは

http://www.dmm.com/rental/-/detail/=/cid=n_612mgb★★★★/
※★★★★の部分は検索の文字列(型番?)
のような感じになっているようです。(n_612mgbの部分も恐らく可変かと思われます)
サイトのアンカー内にはclassしか設定されていないようですので(IE9であればclassから直接拾うことが可能なのですが・・・)、ページ内の全てのアンカーを拾い、固有の部分と型番が一致したリンクが見つかったらクリックしループを抜けるようにしてあります。
(その前に、objという変数をObjectで宣言しておいてください)

For Each obj In objIE.document.getElementsByTagName("a")
If obj.href Like "*★★★★*" And obj.href Like "http://www.dmm.com/rental/-/detail/*" Then
obj.Click
Exit For
End If
Next

その下に画面遷移待ちの処理(質問文内のwaitNavigation)を再度入れます。

次にページ内の情報取得ですが、

作品タイトルは<h1>タグで囲まれており、ページ内に他の同一タグは存在しません。
その為、
Range("B1") = objIE.document.getElementsByTagName("h1")(0).innertext
で出力できます。

貸出開始日、出演者は<td>タグで囲まれています。
tdタグで囲まれている項目は他にも多数あるようですので、試しにMsgboxでページ内からtdタグの項目順番に表示させてみると
「2013/4/3」は5番目
「ダニエル・クレイグ レイフ・ファインズ ジュディ・デンチ ナオミ・ハリス ベレニス・マーロウ ベン・ウィショー ハビエル・バルデム」は13番目に出てきました。

なので以下の様な感じで出力できるかと思います。
Range("C1") = Format(objIE.document.getElementsByTagName("td")(4).innertext, "yyyy.mm.dd")
Range("D1") = objIE.document.getElementsByTagName("td")(12).innertext
※配列で出力されるため、0が1番目になります

もしかしたら検索方法や内容によってページのソースも変わってくるかもしれませんが、そのあたりは質問者様で上手くアレンジして下さい。
後はサイト自体の仕様が変わってしまうと勿論ですが上手く出力できなくなります。

またページ内から情報を取得したい場合、通常の画面遷移待ちの処理では確実に判断されず、実行時エラー91などが出てしまう場合がありますので、もし頻繁に出てしまうようならSleep関数などで数秒ブレークさせる処理を入れると良いかもしれません。

リンク先のサイトは質問を読んで初めて使いましたので、完璧に質問者様の望む回答は出来ないと思いますが、参考程度になればと思い回答させて頂きました。

また質問者様のOSはXPとのことですので、IEのバージョンは8かそれ以前かと思われますが、VBAでIE操作の処理をしたい場合はIE9があれば8に比べてだいぶ楽に書けるかと思います。
今回の回答では8でも動作できるように、のつもりで書きましたが、あくまで動作確認は9で行っているため、もし動かなかったらごめんなさいm(_ _)m

まず、検索結果から通常版への...続きを読む

QExcel ハイパーリンクのURLを別のセルに表示したい。

Excel ハイパーリンクのURLを別のセルに表示したい。

例えば、A1セルに「あいうえお」と入力され、かつハイパーリンクで、
「http://www.aiueo.com」というURLがリンクされているとします。
この、「http://www.aiueo.com」を B1セルに表示させたいです。

なにか良い関数やフリーソフト等はありませんでしょうか??
(ACCESSの場合は、簡単なクエリーのみ利用できるレベルです。)

よろしくお願いします。

Aベストアンサー

こちらで。
http://oshiete.goo.ne.jp/qa/2356920.html

QエクセルのIF関数で、文字が入力されていたならば~

エクセルのIF関数で文字が入力されていたならば~、という論理式を組み立てたいと思っています。

=IF(A1="『どんな文字でも』","",+B1-C1)

A1セルに『どんな文字でも』入っていたならば、空白に。
文字が入っていなければB1セルからC1セルを引く、という状態です。

この『どんな文字でも』の部分に何を入れればいいのか教えてください。

またIF関数以外でも同様のことができれば構いません。

宜しくお願いします。

Aベストアンサー

=IF(ISTEXT(A1),"",B1-C1)

でどうでしょうか?

QExcel 文字列の前後に、特定の文字を付加したい

Excelで、ある列に不規則な文字列がならんでいます。
その文字列の前後に、いっせいに好きな文字を付加したいのです。
例えば、「AAA」という文字列の前後に
「BBBACCC」といったように
AAAといった文字列にBBBやCCCと一斉に付加したいです。
AAAはアルファベットや日本語等さまざまなのですが、
どうすればいいでしょうか?
教えてください。

Aベストアンサー

& で繋ぎます。

A1 セルの文字の前後に、ABC と DEF を付けたいなら、
別のセルに下記のような式を入れます。

="ABC" & A1 & "DEF"

Qエクセルでの指定文字 カウントについて

エクセルで並んだデータでの指定した名前だけの個数をカウントするにはどうすればいいのでしょうか?

山田 高橋 佐藤
高橋 梅田 赤田
 西 山田 梅田
佐藤 山田 梅田

名前が並んだデータで「高橋」という名前が何個あるのかをカウントしたいのですがどうすればいいのでしょうか?

Aベストアンサー

 データは入力されているセルの範囲を「A1:C4」とすれば、

=COUNTIF(A1:C4,"高橋")


人気Q&Aランキング