Shell32ライブラリのインスタンスのオブジェクト

Question

エクセルからインターネットエクスプローラを操作して、任意のULRをからデータを取得しようと考えています。URLのアドレスとテキスト名を引数として、IEへのオブジェクトを返す関数を作ろうかと思いましたが、一向にうまくいきません。コードの99%は、ネット、雑誌からの引用なので問題はない(継ぎ接ぎ上の問題はあるかと思いますが)と思います。やりたいことは、関数から返されるオブジェクトを使ってのTest()の最後の2行の.body.innerTextと、.body.innerHTMLの取得です。
どなたか詳しい方がいらっしゃいましたら教えてください。よろしくお願いいたします。
Sub test()
    Dim myIE As Object
    Dim URL_address As String
    Dim URL_Title As String
    Dim IE_Text As String
    Dim IE_Html As String
    
    ULR_address = "http://oshiete1.goo.ne.jp/c232.html"
    Ulr_Title = "教えて！goo Office系ソフト"
    myIE = IE_URL(URL_address, Ulr_Title)
    IE_Text = myIE.document.body.innerText
    IE_Html = myIE.document.body.innerHTML
End Sub

Function IE_URL(URL_address As String, URL_Title As String) As Object
    Dim myIE As SHDocVw.InternetExplorer
    Dim myIE2 As Object
    
    '　起動しているIEの中にURL_Titleと合致するULRがあるか調べる
    With New Shell32.Shell
        For Each myIE In .Windows
            If UCase(Dir(myIE.FullName)) = "IEXPLORE.EXE" Then
                If myIE.document.Title = URL_Title Then
                    myIE.Navigate URL_address
                    Exit For
                End If
            End If
        Next
    End With
    
    'URL_Titleと合致するURLがない場合、新たにIEを立ち上げて表示させる
    If myIE Is Nothing Then
        With New SHDocVw.InternetExplorer  '
            .Navigate URL_address
            .Visible = True
        End With
        Application.Wait Now + TimeValue("00:00:01")
        'myIEにオブジェクトをセットさせるために再度全体を検索する(上のwithでオブジェクトを取得できれば不要)
        With New Shell32.Shell
            For Each myIE In .Windows
                If UCase(Dir(myIE.FullName)) = "IEXPLORE.EXE" Then
                    If myIE.document.Title = URL_Title Then
                        myIE.Navigate URL_address
                        Exit For
                    End If
                End If
            Next
        End With
    End If
    Set myIE2 = GetObject(myIE.FullName)
    IE_URL = myIE2

End Function

Wendy02 · Accepted Answer

こんばんは。Wendy02です。

解決したようですが、
>オブジェクト変数またはWithブロック変数が定義されていませんって出てきました。

最初に書いたけれども、それは、消してしまいました。

＞コードの99%は、ネット、雑誌からの引用なので問題はない(継ぎ接ぎ上の問題はあるかと思いますが)と思います。

すみません。読み違えました。ちょっと、言い訳させていただきます。ふだんは、気にしないのですが、今回は、特別なのです。私も、掲示板を長く利用していますが、ここはよいけれども、荒っぽい所もあるので、トラブルだけは、よく覚えています。

回答者として、他人のものを触れるのは、なかなか、難しい時があります。特に、異質な内容のコードは、神経質になってしまうのです。回答者側の私が、うかつに、（良否関係なく）注釈やコメントを書いて、その後、まったく関係のないことで、トラブルに巻き込まれることがあるからです。

どこをどの程度、直したのかはわかりませんが、今回のコードは、7割ぐらいはオリジナルを残しているように思えたのです。概して、そのコードは、上級レベルのワザはあるのですが、全体が、ちぐはぐしているのです。おそらく、オリジナル自体がそうだとは思うのですが、今回のようなレベルのコードが、一番、コメントなどが書きづらいものなのです。元を書いた人の実力のレベルが透けて見えてくるからです。こういう場合は、こちらが最初から書いたほうが、よほど気持ち的に楽なのです。

>?の件については、半角スペースが入るとgoo登録時に化けるみたいです。

それも、そのようですね。失礼しました。

この後に、だいたいは、IE_Hteml 側から切り分け作業をしていくのですが、その時に、正規表現のスキルを持たないと、ものすごく面倒になります。

Wendy02 · Answer

こんばんは。Wendy02です。

ご自身のコードですか？

コードのスタイルも独特ですし、無意味な部分がところどころあります。もし、他人のものでしたら、なるべく、そのURLはともかくとして、自分のものではない旨を書いてください。その人の力のレベルが分からなくなるのです。初歩的なミスがあるので、分かっているのか分かっていないのか、良く分からないのです。


ULR_address = "?http://oshiete1.goo.ne.jp/c232.html?"

最初に、VBAでは、この「?」区切り記号は、使えないと思います。

まったくの余談ですが、今は、
"http://oshiete1.goo.ne.jp/goo_oshiete.php3?c=232"
このURLです。こちらのマクロで開かないので、何か失敗したかと思いました。
確か、前のURLのはずです。

Main側のコードには、最後に、

　Set myIE = Nothing
を入れてください。

Function IE_URL　の中の、

With New Shell32.Shell　は、参照設定した上でのことでしょうけれども、コードの中で、何度も、インスタンスを作っていたのでは、プロシージャの取得したオブジェクトがつながりません。

作成後に整えるためには可能でも、製作中の段階ではこういうのはしません。ローカルモジュールが見られないからです。

今回のコードは、まだ、緒についただけで、この先が難しいように思います。がんばってトライしてください。


　　With New Shell32.Shell
　　'myIE は、IEオブジェクトではありません。ただのオブジェクトです。
　　　　For Each myIE In .Windows
　　　　　　'Dir がヘンです。ありえません。
　　　　　If UCase(Dir(myIE.FullName)) = "IEXPLORE.EXE" Then
　　　　　　 'タイトルでチェックは難しいです。
　　　　　　 '= では、ロジックが違います。<> です。
　　　　　　　　If myIE.document.Title = URL_Title Then
　　　　　　　　　　myIE.Navigate URL_address
　　　　　　　　　　Exit For 
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　End With
　　　　IEのTitel比較は、たとえば、このようなスタイルがよいです。
　　例：
　　 If InStr(myIE.LocationName, "教えて") > 0 Then
　　
　　UCase(Dir(myIE.FullName)) = "IEXPLORE.EXE"
IE があるなしの前提なんていうのは、コード以前の問題だと思うのです。
ShellオブジェクトのWindow の中を探さなくてはいけません。

最後の部分で、別にGetObjectで、インスタンスを取り直す意味がないと思います。

僭越かもしれませんが、なるべく、元の雰囲気を壊さずに、私のほうから手直しをさせていただきました。一部、無駄な部分もありますが、元のコードと比較してみてください。レベル的には、そんなに難しいものではありません。

Function IE_URL(URL_address As String, URL_Title As String) As Object
　　Dim o As Object
　　Dim myIE As SHDocVw.InternetExplorer
　　Dim mySh As Shell32.Shell
　　Dim Connectflg As Boolean
　　Dim cnt As Long
　　
　　On Error GoTo ErrHandler
　　
　　Set myIE = New SHDocVw.InternetExplorer
　　Set mySh = New Shell32.Shell
　　Connectflg = False
　　
　　'　起動しているIEの中にURL_Titleと合致するULRがあるか調べる
　　With mySh
　　　　
　　　　For Each o In .Windows
　　　　　　If StrComp(TypeName(o), "IWebBrowser2") = 0 Then　'TextCompare
　　　　　　　 If o.ReadyState = READYSTATE_COMPLETE Then
　　　　　　　　　If o.LocationURL = URL_address Then
　　　　　　　　　　Set myIE = o
　　　　　　　　　　Connectflg = True
　　　　　　　　　　Exit For
　　　　　　　　　End If
　　　　　　　 End If
　　　　　　 End If
　　　　Next o
　　End With
　　
　　'URL_Titleと合致するURLがない場合、新たにIEを立ち上げて表示させる
　　If Connectflg = False Then
　　　　With myIE
　　　　　　.Navigate2 URL_address
　　　　　　.Visible = True
　　　　End With
　　End If
　　With myIE
　　　　Application.Wait Now + TimeValue("00:00:01")
　　　　
　　　　Do Until .ReadyState = READYSTATE_COMPLETE 
　　　　　　cnt = cnt + 1
　　　　　　If cnt > 10000 Then　 '失敗の時に、カウントを取って、離脱させる
　　　　　　　　 MsgBox "アクセスできませんでした。", 64
　　　　　　　　Exit Function
　　　　　　End If
　　　　Loop
　　End With
　　Set IE_URL = myIE
ErrHandler:
　　If Err.Number > 0 Then
　　　 MsgBox Err.Number & " : " & Err.Description
　　End If
　　Set myIE = Nothing
　　Set mySh = Nothing
End Function

Shell32ライブラリのインスタンスのオブジェクト

こんばんは。

こんばんは。

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング