みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

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

解決済みの質問

ExcelのVBAで ホームページのソースコード

vExcelのVBAで ホームページのソースコード一部分をぬきたいのですが、わかるかたおしえてください。

http://onlinestore.barneys.co.jp/html/item/001/049/item48187.html

こちらのサイトのZOOMUPした時の画像のURLを取得したいのです。


A列には、URL でB列にはその画像URLを自動で取得というかんじです。


わかるかた教えていただけないでしょうか。

投稿日時 - 2013-01-22 12:16:49

QNo.7904549

すぐに回答ほしいです

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

http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q13100697753
の方に全く同じご質問が出ておりますが、別の方法で回答いたします。

Sub with_HttpRequest()
  Dim objHTTP As Object
  Dim i As Long
  Dim myHtml As Variant
  Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
  With objHTTP
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
      .Open "GET", Range("A" & i).Value, False
      .Send
      If InStr(.responseText, "previewPath") > 0 Then
        myHtml = Split(.responseText, "previewPath")(2)
        Range("B1").Offset(i - 1).Value = _
          "http://onlinestore.barneys.co.jp" & Split(myHtml, "'")(1)
      Else
        Range("B1").Offset(i - 1).Value = "無効なURLです"
      End If
    Next i
  End With
  Set objHTTP = Nothing
End Sub

投稿日時 - 2013-01-26 01:18:52

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

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

回答(2)

ANo.1

http://www.ken3.org/cgi-bin/group/vba_ie_link.asp

このサイトのほぼ丸写しですが


Sub ie_Link_TEST()

'1.調査したいURLをInputBoxで受け取ります(かなり手抜き・・・)
Dim strURL As String '入力値を受け取る変数

'INPUTBOXでURLをもらう
strURL = InputBox("調査するURLは?", "URL入力", "http://www.ken3.org/backno/backno_vba_mokuji.html")
If strURL = "" Then
MsgBox "調査したいURLを指定してください"
Exit Sub '途中で抜ける
End If

'2.IEを起動させ、目的のページを表示させます。

Dim objIE As Object 'IEオブジェクト参照用

'IEを起動する
Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
objIE.Visible = True '見えるようにする(お約束)

'.Navigate で 指定したURLを開く
objIE.Navigate strURL

'表示完了を待つ
While objIE.ReadyState <> 4
While objIE.Busy = True
DoEvents '特に何もしないで.Busyの状態が変わるまで待つ
Wend
Wend

'3.目的のページからリンク先を取り出し、セルに書き出します。

Dim i As Integer '添え字 i番目などで使用
Dim yLINE As Integer '行カウンタ、Y行目

'html ドキュメント リンク オブジェクトからデータをセルへ転記(代入)する。
Workbooks.Add '新規ブックを追加 データ転送用に新規のブックを追加する
Range("A1") = "調査したURLは " & strURL & " です" 'A1にURLを記述(セット)
Range("D1") = "リンクの数は " & objIE.Document.Links.Length & "です" 'D1にリンクの数をセット

'Range("A2") = ".Href(リンク先)" 'A2~F2 2行目に見出しをセットする
'Range("B2") = ".OuterText"
'Range("C2") = ".OuterHTML"
'Range("D2") = ".InnerText"
'Range("E2") = ".InnerHTML"
'Range("F2") = ".Target"
Columns("A:F").ColumnWidth = 22 '列幅を22に変更

yLINE = 3 'セット開始の行を代入する
For i = 0 To objIE.Document.Links.Length - 1
'データをセルへセットする 'を付けて文字列にする(セルにセットしたいので)
ret = InStr(objIE.Document.Links(i).Href,"jpg") 'リンク先
If ret <> 0 And IsNull(ret) = False Then
Cells(yLINE, "A") = "'" & objIE.Document.Links(i).Href 'リンク先
'Cells(yLINE, "B") = "'" & objIE.Document.Links(i).OuterText '自分を含む テキスト(Innerと変わりない?)
'Cells(yLINE, "C") = "'" & objIE.Document.Links(i).OuterHTML '自分を含む HTML
'Cells(yLINE, "D") = "'" & objIE.Document.Links(i).InnerText '内側のテキスト
'Cells(yLINE, "E") = "'" & objIE.Document.Links(i).InnerHTML '内側のHTML
'Cells(yLINE, "F") = "'" & objIE.Document.Links(i).Target '_Blank や 表示先フレームの名前など

yLINE = yLINE + 1 'セット位置(行)を+1する
End If
Next i

'抜き出し作業が終わったので、通常.QuitでIEを終了させる が 今回は残す
'objIE.Quit
Set objIE = Nothing

MsgBox "処理終了、ブラウザの表示内容 と シートを確認してください"

End Sub

投稿日時 - 2013-01-23 15:21:20

あなたにオススメの質問