Inetコントロールを使ってWEBブラウザーからHTMLドキュメントを取得するコードを作っているのですが、フレームで区切られたページでは各ページのHTMLドキュメントが取得されません。フレームなしのページではうまくHTMLドキュメントを取れるのですが・・・。
何か良い方法はないでしょうか?

> Inetコントロールを使ってWEBブラウザーからHTMLドキュメントを取得するコードを作っているのですが、フレームで区切られたページでは各ページのHTMLドキュメントが取得されません。フレームなしのページではうまくHTMLドキュメントを取れるのですが・・・。
> 何か良い方法はないでしょうか?

フレームを定義したファイルは
フレーム内に表示するページのアドレスや表示の仕方がドキュメントの内容そのものですから
もし「フレーム内のページのドキュメントが取得できない」ということであれば
逆に指定ページのドキュメント内容の取得自体は正常に動作しているということになりそうです

フレーム内に表示しているページの内容を取得したいのであれば、
フレームページ内のアドレスを取得して、
そのアドレスのページを再度直接取得する必要がありそうですね

kanaさん、早速のご返答ありがとうございます。私初心者ですので検討外れの質問をするかもしれませんが、ご教授お願いいたしますm(__)m

>> フレーム内に表示しているページの内容を取得したいのであれば、
> フレームページ内のアドレスを取得して、
> そのアドレスのページを再度直接取得する必要がありそうですね

まず、フレームページ内のアドレスの取得をどう書けばいいのか検討がつかないのです^_^;

フレームのないページは下のようにしてHTMLドキュメントを取得しています。

Textbox.text1=WebBrowser1.Document.activeElement.outerHTML (指定した範囲のHTMLドキュメントの取得)

フレームページ内でこれを実現しようとすればkanaさんのおっしゃる通りフレームページ内の1ページ分だけをブラウザに表示させれば、上記のスクリプトが実行可能のような気がするのですが、1ページ分だけを表示させる方法がわからないので悩んでいます。

どうかよろしくお願いいたします。

No.3341からのツリーは参考になるのではないでしょうか。

> No.3341からのツリーは参考になるのではないでしょうか。

そうなんです、NO.3341プリントアウトして自分なりに勉強しているんですが、初心者なもので基礎ができていないというか、応用がきかないというか(^_^;)
中々うまく動いてくれないんです。もう煮詰まっちゃって、どなたかフレームのURLの取り方とか、1ページだけ表示させる方法をご教授ねがいますm(__)m

> Inetコントロールを使ってWEBブラウザーからHTMLドキュメントを取得するコードを作っているのですが、
> フレームで区切られたページでは各ページのHTMLドキュメントが取得されません。

こんな感じで如何でしょうか。
# エラーチェック等は省略しています。

Option Explicit

Private Sub Form_Load()
    WebBrowser1.Navigate2 "http://www.asahi-net.or.jp/~rg7f-tkhs/frame6.html"
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    SaveDocument "C:\TEST\", pDisp.Document
End Sub

Private Sub SaveDocument(ByVal Folder As String, ByVal Document As Object)
    Dim PF As IPersistFile
    Dim FileName As String
    Dim L As Long

    If TypeName(Document) <> "HTMLDocument" Then
        Exit Sub
    End If
    
    FileName = Document.location.pathname
    FileName = Folder & Mid(FileName, InStrRev(FileName, "/") + 1)

    Set PF = Document
    PF.Save FileName, 0&
    Set PF = Nothing

    With Document.frames
        For L = 0 To .length - 1
            SaveDocument Folder, .Item(L).Document
        Next
    End With
End Sub

みなさん詳しいご回答ありがとうございますm(__)m

魔界の仮面弁士様　丁寧にコードまで書いてくださり感謝しています。
早速、試してみたのですが、

>     Dim PF As IPersistFile

の部分で『コンパイルエラー。ユーザー定義関数が定義されていません。』

というメッセージが出てしまいます。
どのようにすればよろしいのでしょうか。何度もすみませんm(__)m

> >     Dim PF As IPersistFile
> の部分で『コンパイルエラー。ユーザー定義関数が定義されていません。』

IPersistFileインターフェイス用のタイプライブラリを、別途参照設定する必要があります。

ただし、そのためのVB用タイプライブラリは、標準では用意されていませんので、
TLBファイルを自作されるか、あるいは、Eduardo A. Morcillo氏のサイトで公開されている物を
利用されるなどして、別途入手する必要があります。

なお、私の作った物でも良ければ、下記に含まれる SHELLLNK.TLB ファイルも利用できます。
http://www.ocv.ne.jp/~oratorio/windev/vb/CreateShortcut.CAB


…ちなみに、IPersistFile というのは、以下のようなインターフェイスです。

[IPersistFile]
http://yokohama.cool.ne.jp/chokuto/urawaza/interface/IPersistFile/

[IPersistFile::Save]
http://yokohama.cool.ne.jp/chokuto/urawaza/interface/IPersistFile/Save.html

> IPersistFileインターフェイス用のタイプライブラリを、別途参照設定する必要があります。

タイプライブラリを使わないバージョンを作ってみました。
DispCallFunc APIを使って、IPersistFile.Saveを直接呼び出しています。

ついでに、DocumentCompleteイベントでの処理を、ちょっと手直ししてあります。


'===== フォームに、WebBrowserコントロールを貼り付けておき、
'===== そこに下記のコードを記述してください。
Option Explicit

Private Sub Form_Load()
    WebBrowser1.Tag = ""
    WebBrowser1.Navigate2 "http://www.asahi-net.or.jp/~rg7f-tkhs/frame6.html"
End Sub

Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
    '最初に飛ぶURL(フレームの一番外側のページ)を覚えておく
    If WebBrowser1.Tag = "" Then
        WebBrowser1.Tag = URL
    End If
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    '最初のURLが完了した時(全てのページがダウンロードされた時)
    If WebBrowser1.Tag = URL Then
        'ドキュメントを C:\TEST\に保存する
        SaveDocument "C:\TEST\", pDisp.Document
        WebBrowser1.Tag = ""
    End If
End Sub

Private Sub SaveDocument(ByVal Folder As String, ByVal Document As Object)
    Dim FileName As String
    Dim L As Long

    If TypeName(Document) <> "HTMLDocument" Then
        Exit Sub
    End If
    
    '同名のファイル名があった場合、上書きされていってしまうので、
    '実際に使うときには、もう少しこの部分の修正が必要になるかも。
    Debug.Print Document.location.href
    FileName = Document.location.pathname
    FileName = Folder & Mid(FileName, InStrRev(FileName, "/") + 1)

    With New PersistFile
        .SetObject Document
        .Save FileName, False
    End With

    With Document.frames
        For L = 0 To .length - 1
            SaveDocument Folder, .Item(L).Document
        Next
    End With
End Sub


'===== クラスモジュールを追加し、クラス名を PersistFile という名前にしてから、
'===== そこに下記のコードを記述してください。
Option Explicit

Private Type UUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type
Private mudtIPersistFile As UUID    'IID_IPersistFileの格納用

Private Const autCCStdCall = 4
Private Declare Function DispCallFunc Lib "oleaut32" _
   (ByVal pvInstance As Long, _
    ByVal oVft As Long, _
    ByVal CallConv As Integer, _
    ByVal vtReturn As Integer, _
    ByVal cActuals As Long, _
    ByRef prgvt As Integer, _
    ByRef prgpvarg As Long, _
    ByRef pvargResult As Variant _
) As Long

Private mobjSource As Object
Private mlpPersistFile As Long

'メソッドの位置
Private Const comIUnknown_QueryInterface = 0
Private Const comIUnknown_Release = 8
Private Const comIPersistFile_Save = 24

Private Sub Class_Initialize()
    '{0000010b-0000-0000-C000-000000000046}
    With mudtIPersistFile
        .Data1 = &H10B
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With
End Sub

Public Sub SetObject(ByVal Source As Object)
    Set mobjSource = Source
    If Source Is Nothing Then
        mlpPersistFile = 0
    Else
        Dim hResult As Long
        
        If mlpPersistFile <> 0 Then
            Call Invoke_(mlpPersistFile, comIUnknown_Release)
            mlpPersistFile = 0
        End If

        hResult = Invoke_(ObjPtr(Source), comIUnknown_QueryInterface, _
                    VarPtr(mudtIPersistFile), VarPtr(mlpPersistFile))
        If hResult < 0 Then
            mlpPersistFile = 0
            Err.Raise hResult
        End If
    End If
End Sub

Public Sub Save(ByVal pszFileName As String, ByVal fRemember As Boolean)
    Dim bytFileName() As Byte
    Dim hResult As Long
    Dim lngBool As Long

    If mlpPersistFile = 0 Then
        'オブジェクト変数またはWithブロック変数が設定されていません。
        Err.Raise 91
        Exit Sub
    End If

    bytFileName = pszFileName & vbNullChar
    lngBool = IIf(fRemember, 1&, 0&)

    hResult = Invoke_(mlpPersistFile, comIPersistFile_Save, _
                        VarPtr(bytFileName(0)), lngBool)
    If hResult <> 0 Then
        Err.Raise hResult
    End If
End Sub

Private Function Invoke_(ByVal lpObject As Long, ByVal VtblOffset As Long, _
                         ParamArray Args() As Variant) As Long
    Dim lngPtArgs() As Long
    Dim intVtArgs() As Integer
    Dim varResult As Variant
    Dim lngArgs As Long
    Dim n As Long
    
    If lpObject = 0 Then
        Exit Function
    End If

    lngArgs = UBound(Args) - LBound(Args) + 1
    If lngArgs = 0 Then
        ReDim lngPtArgs(0), intVtArgs(0)
    Else
        ReDim lngPtArgs(lngArgs - 1), intVtArgs(lngArgs - 1)
        For n = 0 To lngArgs - 1
            intVtArgs(n) = VarType(Args(n))
            lngPtArgs(n) = VarPtr(Args(n))
        Next
    End If

    n = 0
    n = DispCallFunc(lpObject, VtblOffset, autCCStdCall, _
            vbLong, lngArgs, intVtArgs(0), lngPtArgs(0), varResult)
    If n >= 0 Then
        Invoke_ = CLng(varResult)
    End If
End Function

Private Sub Class_Terminate()
    Call Invoke_(mlpPersistFile, comIUnknown_Release)
    mlpPersistFile = 0
    Set mobjSource = Nothing
End Sub

> > IPersitFileインターフェイス用のタイプライブラリを、別途参照設定する必要があります。

ありがとうございます。早速魔界の仮面弁士さんのファイルをいただき、参照設定いたしましたところ
コンパイルエラーはなくなったのですが、今度は

> Set PF = Document

のところで『型の不一致』のメッセージが

> PF.Save FileName, 0&

のところで『オブジェクトはこのプロパティまたはメソッドをサポートしていません』のメッセージが出てしまいます(^_^;)


> タイプライブラリを使わないバージョンを作ってみました。


こちらのタイプでは

>     With New PersistFile

のところで『ユーザー定義関数が定義されていません』のメッセージが出てしまいます(^_^;)

1日格闘していましたが、朝がきました、限界です・・・。

あと少しヒントをいただけませんでしょうか。お願いいたしましすm(__)m

> > タイプライブラリを使わないバージョンを作ってみました。
>
>
> こちらのタイプでは
>
> >     With New PersistFile
>
> のところで『ユーザー定義関数が定義されていません』のメッセージが出てしまいます(^_^;)
>
> 1日格闘していましたが、朝がきました、限界です・・・。
>
> あと少しヒントをいただけませんでしょうか。お願いいたしましすm(__)m

　よこやり失礼します。
私もこの手のプログラムに興味があって、ずっと拝見しておりました。
問題のエラーの件ですが、クラスモジュールソース内の先頭
>>>'===== クラスモジュールを追加し、
>>> クラス名を PersitFile という名前にしてから、
この部分、忘れていませんか？

> 　よこやり失礼します。
> 私もこの手のプログラムに興味があって、ずっと拝見しておりました。
> 問題のエラーの件ですが、クラスモジュールソース内の先頭
> >>>'===== クラスモジュールを追加し、
> >>> クラス名を PersitFile という名前にしてから、
> この部分、忘れていませんか？

　それでも私の場合、SetObject内の
        hResult = Invoke_(ObjPtr(Source), comIUnknown_QueryInterface, _
                    VarPtr(mudtIPersistFile), VarPtr(mlpPersistFile))
　この部分で
　hresult = -2147467262 となり
「クラスはオートメーションまたは予測したインターフェースをサポートしていません。」
　のエラーが出ていますが・・・

これさんご指摘ありがとうございます。


> > >>> クラス名を PersitFile という名前にしてから、
> > この部分、忘れていませんか？


『PersitFile』ではなくて『PersistFile』ですね。
コピペしてしまったので『s』が抜けていました(^_^;)

> 　それでも私の場合、SetObject内の
>         hResult = Invoke_(ObjPtr(Source), comIUnknown_QueryInterface, _
>                     VarPtr(mudtIPersistFile), VarPtr(mlpPersistFile))
> 　この部分で
> 　hresult = -2147467262 となり
> 「クラスはオートメーションまたは予測したインターフェースをサポートしていません。」
> 　のエラーが出ていますが・・・

私も同様です。何かがたりないのかなぁ。

コンポーネントの追加で
Microsoft Internet Controls にチェックを入れて
フォーム上に配置していますか？
地球だけのアイコンの方  (　WebBrowser )

他は下記を修正しただけで動きますが。

> 『PersitFile』ではなくて『PersistFile』ですね

フォローありがとうございます。

私の方からも、何点か確認したい点があります。

まず気になるのは、IE のバージョンと、表示させている URL です。

私の環境は、「IE6/SP1 + 各種セキュリティパッチ」「WinXP Pro SP1」です。
(IE6以外の環境や、WinXP/SP1a等で動作するかどうかは検証していません)

もしかしたら、古いIEの場合は、DocumentCompleteイベント中では、まだHTMLDocumentの解析が
終わっておらず、WebBrowser.Documentにアクセスできない状態になっているのかも知れません。
念のため、ファイルへ保存するコードを、DocumentComplete から Command1_Click 等に移動し、
ページの読み込みが完全に終わってから、十分な時間(数秒後など)をおいてから、
ファイルの保存を行うようにしてみてください。


また、URLに関しても、「ファイル名として使えない文字が含まれているURL」や、
"http://www.microsoft.com/japan/" のように「ファイル名の無いURL」が指定されていた時には、
    FileName = Document.location.pathname
    FileName = Folder & Mid(FileName, InStrRev(FileName, "/") + 1)
というコードの部分で、適切なファイル名を取得できないため、また別のエラーが
発生する可能性も考えられます。その点はご了承ください。

また、 http://www.ocv.ne.jp/~oratorio/windev/Excel/frameTest.html のように、
フレーム内でHTML以外の文書を表示させているページなどでも、ファイルへの保存が
失敗する事になります。そうしたページも保存させたいのであれば、DocumentをSaveするのではなく、
Inetコントロール等を用いて、別途URLからダウンロードしなおすようなコーディングを
行う必要があるかと思います。


# なお、COM APIに関しては、私自身、さほど深く理解しているわけではないので、もしかしたら
# コードに間違いがあるかも知れません。気づいた点があれば、指摘していただけると幸いです。

> フォローありがとうございます。
> 私の方からも、何点か確認したい点があります。
> まず気になるのは、IE のバージョンと、表示させている URL です。
>
> 私の環境は、「IE6/SP1 + 各種セキュリティパッチ」「WinXP Pro SP1」です。
> (IE6以外の環境や、WinXP/SP1a等で動作するかどうかは検証していません)
>
> もしかしたら、古いIEの場合は、DocumentCompleteイベント中では、まだHTMLDocumentの解析が
> 終わっておらず、WebBrowser.Documentにアクセスできない状態になっているのかも知れません。
> 念のため、ファイルへ保存するコードを、DocumentComplete から Command1_Click 等に移動し、
> ページの読み込みが完全に終わってから、十分な時間(数秒後など)をおいてから、
> ファイルの保存を行うようにしてみてください。

便乗なので非常に恐縮しつつも
自分でもイロイロ試行錯誤中ですので
とりあえず環境がらみの点だけご報告。

私の環境は Win2K(SP2) VB6.0(SP5)
IE5.5SP2 + 重要とおぼしきセキュリティパッチ です。

URLはサンプルソースのままですので
ｈttp://www.asahi-net.or.jp/~rg7f-tkhs/frame6.html です。
メインURLであるFrame6.htmlは保存されるのですが
中の子フレームのページがダメですね。
とりあえずCommandButtonを用意して
そっちに処理を移してもみたのですが現状では同じです。
(このあたり＋Inetで別保存を検討中です。)

マーシーさんの方はいかがでしょうか？

> メインURLであるFrame6.htmlは保存されるのですが
> 中の子フレームのページがダメですね。
一番外側（WebBrowserコントロールのDocumentプロパティの内容）は保存できるけれども、
その中（frameオブジェクトのdocumentプロパティ）が保存できない、と……。φ(..;)

> (このあたり＋Inetで別保存を検討中です。)
その方が良いかも知れませんね。
同じファイルを複数回ダウンロードする事になるのが難点ですが、そのかわり、
HTMLファイルだけではなく、画像等のファイルも取得する事ができるでしょうし。

> 『PersitFile』ではなくて『PersistFile』ですね。
> コピペしてしまったので『s』が抜けていました(^_^;)

うわぁ、すみません。パーシストのスペルが一部間違っていますね。(;_;)

# 現在は、元投稿(No.3882)のスペルを修正してあります。


>>         hResult = Invoke_(ObjPtr(Source), comIUnknown_QueryInterface, _
>>                     VarPtr(mudtIPersistFile), VarPtr(mlpPersistFile))
これは、IUnknown.QueryInterface を呼んでいるところですね。
タイプライブラリを使った場合で言えば、
  Dim objPersistFile As IPersistFile
  Set objPersistFile = Source
という処理を行う部分になります。


>> 「クラスはオートメーションまたは予測したインターフェースをサポートしていません。」
>> 　のエラーが出ていますが・・・
Sourceで指定されたオブジェクトが、IPersistFileを持っていなかった、という事ですね。
その場合は、呼び出し側にて On Error を使って、例外処理を行うようにしてみてください。

なおその場合、VBのエラートラップモードを、既定の「クラスモジュールで中断」から、
「エラー発生時に中断」にしておく必要があります。
# エラートラップモードを変更しておかないと、開発環境での実行時では、
# クラス内のErr.Raise部で、実行が中断されてしまいますので。

> > Set PF = Document
> のところで『型の不一致』のメッセージが

IPersistFileインターフェイスを持たないドキュメントの場合、
型変換に失敗します。その場合は、
  If TypeOf Document Is IPersistFile Then
     Set PF = Document
        :
  End If
のようにして判定するようにしてください。

> >     With New PersistFile
> のところで『ユーザー定義関数が定義されていません』のメッセージが出てしまいます(^_^;)
これに付いては、他の方が書いてくださったように、クラス名が間違っているのが原因でしょう。
規定の「Class1」という名前にしているなら、With New Class1 ですね。

nobuさん、魔界の仮面弁士さん何度もありがとうございます。

>nobuさん、WebBrowserコンポーネントは参照設定されていて、フォーム上に配置されております。nobuさん動いているんですね、うらやましぃ・・・。

>魔界の仮面弁士さん、

(1)環境は WinMe,IE5.5.サイトはコードにあったところです。明日にでもXP,IE6.0でやってみます。
(2)クラスモジュールを使った場合、

  If TypeOf Document Is IPersistFile Then

    Set PF = Document
    PF.Save FileName, 0&
    
   End If
とすると、

　PF.Save FileName, 0&

のところで『オブジェクトはこのプロパティーまたはメソッドをサポートしていません。』とエラーが出ます。

(3)クラスモジュールを使わない場合は
On Error Resume Next

    With New PersistFile
        .SetObject Document
        .Save FileName, False
    End With

とするとエラー回避下だけのような気がするんですが(^_^;)

(4)
読み込みに時間をかけるのはまだやっていません。

みなさんてこずらせて本当にすみませんm(__)m

> >nobuさん動いているんですね、

この「動いている」は起動すると上、中、下に３分割。
その上で上と下は２分割。合計５ヶ。
右上には「右フレームの画面」と表示されています。
そしてＣ：￥ｔｅｓｔ￥フォルダ内に　framemenu.html　を含めて
７ヶのｈｔｍｌファイルが作成されています。
．．．で良いんですよね？

こちらの環境は VB6 SP5 , WinXp pro ver 2002 sp1
IE 6.0.2800.1106xpsp1.02..... と続きます。

> この「動いている」は起動すると上、中、下に３分割。
> その上で上と下は２分割。合計５ヶ。
> 右上には「右フレームの画面」と表示されています。
> そしてＣ：￥ｔｅｓｔ￥フォルダ内に　framemenu.html　を含めて
> ７ヶのｈｔｍｌファイルが作成されています。
> ．．．で良いんですよね？

はい。そのような結果になる事を想定しています。


> こちらの環境は VB6 SP5 , WinXp pro ver 2002 sp1
> IE 6.0.2800.1106xpsp1.02..... と続きます。

おぉ、私と全く同じ環境のようですね。

HTMLDocumentオブジェクトにはIPersistFileインターフェイスがインプリメントされていますので、
TypeName(Document)が "HTMLDocument" という文字列を返しているのであれば、
    Dim PF As IPersistFile
    Set PF = Document
あるいは、
    With New PersistFile
      .SetObject Document
    End With
の部分では、通常、エラーにはならないと思います。………多分(;_;)


> 　PF.Save FileName, 0&
> のところで『オブジェクトはこのプロパティーまたはメソッドをサポートしていません。』とエラーが出ます。

う〜む。。。何故でしょうか。。。

……もしかしたら、HTMLDocumentのバージョンにもよるのかも知れません。
タイプライブラリを参照設定した上で、

  Dim P As IPersist
  Dim X As CLSID
  Set P = Document
  P.GetClassID X
  Debug.Print "{"; Right(String(8, "0") & Hex(X.Data1), 8);
  Debug.Print "-"; Right(String(4, "0") & Hex(X.Data2), 4);
  Debug.Print "-"; Right(String(4, "0") & Hex(X.Data3), 4);
  Debug.Print "-";
  For L = 0 To 1
      Debug.Print Right(String(2, "0") & Hex(X.Data4(L)), 2);
  Next
  Debug.Print "-";
  For L = 2 To 7
      Debug.Print Right(String(2, "0") & Hex(X.Data4(L)), 2);
  Next
  Debug.Print "}"
を実行するとどうなりますでしょうか。

私の環境では、
  {25336920-03F9-11CF-8FD0-00AA00686F13}
という文字列が得られ、それに対応するレジストリ項目
   HKEY_CLASSES_ROOT\CLSID\{25336920-03F9-11CF-8FD0-00AA00686F13}\Version
には、"6.0"という文字列がありました。


> 読み込みに時間をかけるのはまだやっていません。
この場合は、
  Private Sub Command1_Click()
      MsgBox "保存開始"
      SaveDocument "C:\TEST\", WebBorser1.Document
      MsgBox "保存完了"
  End Sub
のようなコードになります。

タイプライブラリを使用する方法も、使用しない方法も両方共動作しております。

Windows98 SE  VB6.0(SP5)  IE6.0(SP1)

魔界の仮面弁士さんはじめみなさんどうもありがとうございましたm(__)m
花ちゃん様、掲示板汚して申し訳ございませんでした。

当方VBはじめてまだ日が浅いのにこんな上級者の方々のお手を煩わせて大変恐縮しております。
あとは私の努力次第でなんとかなるような気がしますし、あまり頼ってばかりではご迷惑ですので質問はこのへんにしておきます。この質問は特に仕事で必要なわけでもなく、あくまで私の勉強の課程で考えたことでしたので。でもいろいろ大変勉強になりました。わたくしも早くみなさんに追いついて(無理かもしれないけど・・・)、どなたかの質問に答えれるようがんばっていきたいと思っております。

本当にこのたびはありがとうございましたm(__)m