Sub test_filemake()
'ファイルの作成テストを行う
Dim nFNO As Integer
Dim strFNAME As String 'ファイル名
'ファイル名を作成する、ブックの位置＋test.html
strFNAME = ThisWorkbook.Path & "\test.html"
nFNO = FreeFile '空いているファイル番号をもらう
Open strFNAME For Output As #nFNO '新規にファイルをオープン
Print #nFNO, "<html><head><title>TEST</title></head>"
Print #nFNO, "<body>"
Print #nFNO, "<h1>書籍販売ページのテスト</h1>"
Print #nFNO, "</body>"
Print #nFNO, "</html>"
Close #nFNO
MsgBox strFNAME & "に書き込みました"
End Sub |
普通に、ファイルをオープンして、HTMLファイルを作成してみました。
あとは、ループでリンクのデータを作成したいので、
Sub test_filemake()
'ファイルの作成テストを行う
Dim nFNO As Integer
Dim strFNAME As String 'ファイル名
Dim nYLINE As Integer '行番号
'ファイル名を作成する、ブックの位置＋test.html
strFNAME = ThisWorkbook.Path & "\test.html"
nFNO = FreeFile '空いているファイル番号をもらう
Open strFNAME For Output As #nFNO '新規にファイルをオープン
Print #nFNO, "<html><head><title>TEST</title></head>"
Print #nFNO, "<body>"
Print #nFNO, "<h1>書籍販売ページのテスト</h1>"
'データシートを選択する
Sheets("DATA").Select
'ループで書籍データを作成する
For nYLINE = 2 To 31
'書籍のリンクデータを作成する
Print #nFNO, "<A HREF='http://books.rakuten.co.jp/afvc/r.jsp";
Print #nFNO, "?sid=38866&pid=871611930";
'-を除いたISBN番号を書き込む(Replaceで取り除く)
Print #nFNO, "&i=" & Replace(Cells(nYLINE, "E"), "-", "");
Print #nFNO, "'>"
'タイトルを書き込む
Print #nFNO, Cells(nYLINE, "B")
'タグを閉める
Print #nFNO, "</A><br>"
Next nYLINE
Print #nFNO, "</body>"
Print #nFNO, "</html>"
Close #nFNO
MsgBox strFNAME & "に書き込みました"
'メニューシートに戻る
Sheets("Menu").Select
End Sub |
ループで回して、Printステートメントで単純に書き込みました。
あとは、Webクエリの更新作業をマクロ記録して、
↑新しいWebクエリを作成する
アドレスを入力して、移動ボタンを押します。
↑目的のページへ移動する
次は、取り込む範囲を選択して、取り込みボタンを押します。
↑目的のテーブルを選択する。
取り込みボタンを押すと、取り込み位置を聞いてきます。
ここでは、左上のa1を選択しました。
↑目的のテーブルを選択する。
無事にデータを取り込むことが出来ました。
A列 B列 C列 D列 E列 F列
順位 書名 出版社名(略称) 価格 ISBN 発売日
1 CPUの創りかた 毎コミ 2800 4-8399-0986-5 2003/9/30
2 速効!図解 ホームページ 1280 4-8399-0997-0 2003/3/13
3 平成15年度版 CAD利用技 3333 4-87193-916-2 2003/2/28
4 写真・イラスト入りはが 1280 4-7980-0455-3 2003/1/30
と、簡単に読み込むことが出来ました。