VBA webクエリをループさせる方法が知りたい

質問

Excel VBAを使用してwebクエリをループさせる方法が知りたいです。

例えば、以下のように複数のURLがあったとします。
Sheet1のB2セル～B3、B4、B5・・・

━━【B】━━━━
【1】
【2】http://dailynews.yahoo.co.jp/fc/
【3】http://shopping.yahoo.co.jp/
【4】http://www.yahoo.co.jp/
【5】http://chiebukuro.yahoo.co.jp/
【6】http://dic.yahoo.co.jp/
・
・
・
━━━━━
上記すべてのwebページの内容をコマンドボタンワンプッシュでSheet2のA1セルから下へ順に反映させたいといった感じです。

当方VBA初心者ですので、できるだけわかりやすくご教授頂けると助かります。
よろしくお願いいたします。

回答No.3

DOUGLAS_ · ベストアンサー

＞Excel VBAを使用してwebクエリをループさせる方法が知りたいです。
　「webクエリ」ですよね？
　Excel の 標準メニュー [データ(D)] - [外部データの取り込み(D)] - [新しい Web クエリ(W)...] のお話しとして回答を書かせていただきます。

【作業の段取り】
１）先ず、データ を取り込む「Sheet2のA1セル」を アクティブ にします。
２）次に「Sheet1のB2セル～B3、B4、B5・・・」の ＵＲＬ を１つずつ読み込んで、WEb クエリ を実行します。
３）１つの ＵＲＬ の データ を読み込んだ後には、その クエリ デーブル の最終行の次行を アクティブ にします。

【ＶＢＡ の コード を書く場所について】
　「コマンドボタン」を右クリック し、[コードの表示(V)] を クリック すると、
Private Sub CommandButton*_Click()
End Sub
というような コード が現われます（「*」の部分は数字）ので、その２行の「間」に
　　Sheets("Sheet2").Select
　　Application.Run "Sheet2.webクエリをループ"
を コピペ してください。

　次に、Sheet2 の シート タブ を 右クリック し、[コードの表示(V)] を クリック すると現われる コード ウィンドウ に下記を コピペ してください。

Sub webクエリをループ()
　　Dim myQT As QueryTable
　　Dim i As Long
　　Dim myURL As String
　　Cells.Delete
　　For Each myQT In QueryTables: myQT.Delete: Next
　　Range("A1").Select
　　For i = 2 To Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
　　　　myURL = Sheets("Sheet1").Cells(i, "B").Value
　　　　With QueryTables _
　　　　　　　　.Add(Connection:="URL;" & myURL, Destination:=Selection)
　　　　　　.BackgroundQuery = False
　　　　　　.AdjustColumnWidth = False
　　　　　　.WebSelectionType = xlEntirePage
　　　　　　.WebFormatting = xlWebFormattingNone
　　　　　　.Refresh BackgroundQuery:=False
　　　　End With
　　　　Cells(ActiveCell.Row + QueryTables(1).ResultRange.Rows.Count, 1).Select
　　Next
End Sub

【コーディング について】
　先ず、
.BackgroundQuery = False
以下の、QueryTables の プロパティ につきましては、実情に応じて変更なさってください。

　QueryTables の操作は、当該シート を離れると、記述が厄介になりますので、Sheet2 に 実行マクロ を書いて、その マクロ を CommandButton*_Click() で呼び出すようにしました。

【クエリ デーブル の最終行の取得】
　ポイント としては、１つの ＵＲＬ の データ を読み込んだ後の最終行の取得ですが、最後に実行された Web クエリ について QueryTables の インデックス が「1」になるようですので、
QueryTables(1).ResultRange.Rows.Count
が 当該 クエリ テーブル の行数になります。

　従いまして、現在の カーソル 位置（データ の反映位置「Destination」）の行番号に、それを足すと、「クエリ デーブル の最終行の次行」を取得できます。
Cells(ActiveCell.Row + QueryTables(1).ResultRange.Rows.Count, 1).Select

【これは、余談かも知れませんが。。】
　Sheet2 の データ を全部削除しても、QueryTables がそのまま残って、ファイル の容量を大きくしたり、他にも問題が残りそうな気がします。
　これを回避するためには、
　　For Each myQT In QueryTables: myQT.Delete: Next
を付加しました。

回答No.2

layy

参考で。

やり方は違いますが、似たようなことはしています。

１）
画面のハードコピーを（ショートカット押すだけで）取得するフリーソフトを使う。
２）
ｗｅｂを参照し、
とあるフォルダに「xxxx01.jpg」「xxxx02.jpg」「xxxx03.jpg」・・・と
ハードコピーのファイルがファイル名が規則的にできあがる。
３）
エクセルのマクロでこのフォルダの「*.jpg」ファイルを取得して
シート１に順番に列挙する。

画像ファイルを作るまでは自分で操作してがんばって、
画像ファイルを一括でエクセルへ、というのはＶＢＡに任せたことあります。

回答No.1

layy

確認。

シート１のB2を押すとそのリンクが表示される
画面のハードコピーを取得
取得した画面をシート２のＡ１へ貼り付け

シート１のB3を押すとそのリンクが表示される
画面のハードコピーを取得
取得した画面をシート２のＡ５１へ貼り付け

シート１のB4を押すとそのリンクが表示される
画面のハードコピーを取得
取得した画面をシート２のＡ１０１へ貼り付け

（貼り付け画像の高さが５０行分、とみた場合）

こんなことがしたいということでしょうか。

補足

ありがとうございます。
そういう感じと言えばそういう感じです。
ただ、上記すべてのことをコマンドボタンワンプッシュでできないでしょうか？