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

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

本日、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"

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

A 回答 (3件)

こんにちは。



> 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 に画像ファイルなどが添付されるような
イメージです。

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

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

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

お礼日時:2008/08/18 18:32

訂正


ゴミが残っていました
下段の方です
-------------------------------------------------------
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"
          ・
          ・
          ・
    • good
    • 0

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フォルダが
同時に作成される方法はありますか?

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

補足日時:2008/08/16 01:28
    • good
    • 0

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

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