EXCEL VBAでWEBページ保存2

質問

何度もお世話になります、よろしくお願いいたします。

本日、EXCEL　VBAでWEBページを完全保存する方法を質問して
下記を紹介していただきました。
Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" ( _
ByVal pCaller As Long, ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long

--------------------------------------------------------------------------------

Sub DownloadFileFromWeb()
Const strUrl As String = "http://www.puremis.net/excel/index.shtml"
Dim strSavePath As String
Dim returnValue As Long
strSavePath = ThisWorkbook.Path & "\" & "Test.htm"
returnValue = URLDownloadToFile(0, strUrl, strSavePath, 0, 0)
If returnValue = 0 Then
MsgBox "Sccess!"
Else
MsgBox "Did not success."
End If
End Sub
-------------------------------------------------
この状態だと動作は完璧なんですが
たくさんのWEBページを保存するようにVBAを組みたいので
HPアドレスの部分に変数を使いたいのです。
この部分です：Const strUrl As String = "http://www.puremis.net/excel/index.shtml"

でも変数を使うとエラーになってしまうので困り果てております。何か良い方法はございませんでしょうか。
よろしくお願いいたします。

回答No.3

KenKen_SP · ベストアンサー

こんにちは。

> WEBページを完全保存する方法

ご質問なさっていることは、かなり面倒なことです...ね。

ご存じかもしれませんが、WEB ページとは HTML ファイル以外にも

　・CSS　スタイルシートファイル
　・JS などのスクリプトファイル
　・画像ファイル

など複数の外部ファイルで構成されています。

　# もちろん、HTML 単一で構成されたページもあります。

ご質問文にあるコードだと、この内 HTML ファイルのみローカルに保存して
いるだけで、出力されたファイルをブラウザで開くと、フルパス指定されて
いない画像などは欠けた状態になるはずです。

画像等も含めてローカルに保存したい場合、URLDownloadToFile API を使用
するなら、HTML の中で参照されている先述の外部ファイルも一緒に
URLDownloadToFile API でダウンロードし、かつ HTML ファイルを解析して
参照リンクも書き変えなければなりません。

■案1.　IE を操作して保存ダイアログを使う方法

' // IE で WEB ページを保存する
Sub Sample1()

　　Const READYSTATE_COMPLETE　　　As Long = 4
　　Const OLECMDID_SAVEAS　　　　　As Long = 4
　　Const OLECMDEXECOPT_PROMPTUSER As Long = 1

　　Dim ie　As Object　 ' // InternetExplorer
　　Dim url As String

　　url = "http://www.goo.ne.jp/"

　　' // ie を起動して目的のページを開く
　　Set ie = CreateObject("InternetExplorer.Application")
　　ie.Visible = True
　　ie.Navigate url
　　While ie.Busy Or ie.ReadyState <> READYSTATE_COMPLETE
　　　　DoEvents
　　Wend
　　' // 初期ファイル名を指定するため WEB ページタイトルを変更します
　　ie.Document.Title = "test"
　　' // ie の保存ダイアログを表示します
　　ie.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_PROMPTUSER

End Sub

保存ダイアログの自動化は可能ですけど、API を駆使した面倒なコードになり
ますので省略します。

■案2.　MHT ファイルでも良ければ...な方法（Windows2000以降限定）

参考（Wiki）： http://ja.wikipedia.org/wiki/MHTML

Sub sample2()

　　' // この方法でも完全ではないが、実用上はほぼ問題ないか。。な

　　Const cdoSuppressNone　　　 As Long = 0
　　Const adSaveCreateOverWrite As Long = 2

　　Dim msg　　　　 As Object ' // CDO.Message
　　Dim stm　　　　 As Object ' // ADODB.Stream
　　Dim url　　　　 As String
　　Dim outFilename As String

　　url = "http://www.goo.ne.jp/"
　　outFilename = ThisWorkbook.Path & "\sample.mht"

　　Set msg = CreateObject("CDO.Message")
　　msg.CreateMHTMLBody url, cdoSuppressNone, "", ""
　　Set stm = msg.GetStream
　　stm.SaveToFile outFilename, adSaveCreateOverWrite
　　stm.Close

　　Set stm = Nothing
　　Set msg = Nothing

End Sub

要するに、メールのように HTML に画像ファイルなどが添付されるような
イメージです。

なお、コードは一切エラー処理はしてませんし、必要最小限しか書いてません。
お試しになる場合は、ご自身で試行錯誤してみて下さい。

お礼

大感謝です。
mhtで全く問題無しです！

本当に本当にありがとうございました！

回答No.2

hige_082

訂正
ゴミが残っていました
下段の方です
-------------------------------------------------------
Sub DownloadFileFromWeb()
Dim strUrl As String
Dim strSavePath As String
Dim returnValue As Long
strUrl = "http://www.puremis.net/excel/index.shtml"
strSavePath = ThisWorkbook.Path & "\" & "Test.htm"
　　　　　　　　　　・
　　　　　　　　　　・
　　　　　　　　　　・

回答No.1

hige_082

Sub DownloadFileFromWeb()
Const strUrl As String = "http://www.puremis.net/excelindex.shtml"
Dim strSavePath As String
Dim returnValue As Long
strSavePath = ThisWorkbook.Path & "\" & "Test.htm"
　　　　　　　　　　・
　　　　　　　　　　・
　　　　　　　　　　・
-----------------------------------------------------------
Sub DownloadFileFromWeb()
Dim strUrl As String​
Dim strSavePath As String
Dim returnValue As Long
strUrl = "http://www.puremis.net/excel/index.shtml"
strSavePath = ThisWorkbook.Path & "\" & "Test.htm"
　　　　　　　　　　・
　　　　　　　　　　・
　　　　　　　　　　・
違い分かりますか
もう少し理解された方が、後々良いと思いますよ

補足

ありがとうございます。
なんとか理解できました。

ずうずうしく追加で質問なんですが

IEでWEBページを完全保存したら
filesフォルダが一緒に作成されますけど
VBAの命令で同じように
htmlファイルと、filesフォルダが
同時に作成される方法はありますか？

よろしくお願いいたします。