Excel VBAでこれまで使えていた InternetExploreがWindows 11で使えなくなりました。(と思ったら、また使えるようになっていた。よくわからないが、いずれは使えなくなる前提でコーディングしておいた方がよいでしょう。）
Excelはサポート切れの2010と、ちと古いです。
ちょっと調べると、代替え策としてフォームのWebBrowserを使う方法が出てきます。Navigateでurlのページを表示するだけならこれが良さそうです。ですが、DOMのメソッドを使って操作する場合、使えないメソッドがいくつかあります。たとえば
getElementsByName
getElementsByClassName
でエラーが発生します。他にも使えないメソッドがあるかもしれません。
これへの解決策として、次のコードのようにDocument.Allを使って全エレメントを取得し、個々にnameやclassNameをチェックする方法が出てきます。
Dim elm As HtmlElement For Each elm In WebBrowser1.Document.All I if elm.GetAttribute("className") = "someName" Then Debug.Printh elm.InnerText End If Next
これは単発で使うには十分かと思いますが、ループで使用するにはいささか重い処理になりそうで、検討の余地ありです。加えてclassには複数の値が設定されることが多く、"="での比較はほとんど場合に不適切でしょう。
ちなみに、「このページのスクリプトでエラーが発生しました」が発生する場合は、navigateを呼ぶ前に次の行を追加します。
WebBrowser1.Silent = True
次に見つけたのはMSXML2.XMLHTTPを使う方法です。次のようなコードでXmlDocumentを作ります。
Dim MyRequest As Object Set MyRequest = CreateObject("MSXML2.XMLHTTP") MyRequest.Open "GET", url MyRequest.send Do Until MyRequest.readyState = 4: DoEvents: Loop Set xmldoc = MyRequest.responseXML
さらに調べた結果、次の方法が見つかりました。これはHTMLをDOMDocumentとして取得し、それからHTMLDocumentを作ります。
次のFunctionを作り、実際に使用しています。
Public Function GetHTMLDoc(url As String) Dim httpReq As Object Set httpReq = CreateObject("MSXML2.XMLHTTP.6.0") httpReq.Open "GET", url, False httpReq.send (Null) Do Until httpReq.readyState = 4: DoEvents: Loop Dim htmlDoc As IHTMLDocument Set htmlDoc = New HTMLDocument htmlDoc.Write httpReq.responseText Set GetHTMLDoc = htmlDoc End Function
この方法はWebページを表示する必要がなく、DOMメソッドで操作するのが目的な場合に適しています。表示を行わないため、処理は高速です。表示も必要な場合は、WebBrowerにHTMLをセットすればよいでしょう。
さて、これで作った HTMLDocument ですが、ちょっと奇妙な動きをします。
htmlDoc.GetElementsByClassName(className)
は動作します。(先頭の"G”は大文字です。）
ですが、個々の HtlmElement には getElementsByClassName を適用できません。
この範囲で十分であれば、従来のIEと同様の方法で利用することができます。
ですが、ある Element の子要素から getElementsByClassName で要素抽出をしたい場合には処理が複雑になります。
そこで、次のようなFunctionを作りました。あるエレメント内の指定のtagNameのものからclassNameを含むものを抽出します。
Public Function GetElementsByClassName(htmlElm As IHTMLElement, tagName As String, className As String) Dim elm As Object, attr As String, list As Collection Dim re As New RegExp: re.pattern = "(^| )" & className & "( |$)" Set list = New Collection For Each elm In htmlElm.getElementsByTagName(tagName) If re.test(elm.getAttribute("className")) Then list.Add elm End If Next Set GetElementsByClassName = list End Function
正規表現はclass属性の最初、または最後か、前後がスペースで区切られているものとマッチします。
re.pattern = "(^| )" & className & "( |$)"
戻り値の型はCollectionになります。インデックスを使う場合、配列と異なり先頭の要素のインデックスは 1 になることに注意してください。
加えて、次のようなFunctionも作りました。私の場合、getElementsByClassNameで見つかった最初の要素を使うことが多く、IEを使った処理では次のようなコードでした。
name = someElm.getElementsByClassName("name")(0).innerText
Public Function GetFirstElementByClassName(htmlElm As IHTMLElement, tagName As String, className As String) Dim elm As Object, val As String Dim re As New RegExp: re.pattern = "(^| )" & className & "( |$)" For Each elm In htmlElm.getElementsByTagName(tagName) If re.test(elm.getAttribute("className")) Then Set GetFirstElementByClassName = elm Exit Function End If Next Set GetFirstElementByClassName = Nothing End Function
呼び出し方は次のようになります。
name = GetFirstElementByClassName(someElm, "div", "name").innerText
戻り値がNothingとなる場合があるなら、次のようなチェックを入れます。
Set elm = GetFirstElementByClassName(someElm, "div", "name") If Not elm Is Nothing Then name = elm.innerText
HtmlDocumentの先頭からclassNameのものを探したい場合は htmlDoc.body または htmlDoc.DocumentElement を htmlElm として渡します。
divs = GetElementsByClassName(htmlDoc.body, "div", "someClass")
私の場合はclassNameでエレメントを抽出する場合はtagNameも同じなので、このような方法の方が都合がよく、かつ処理速度も多少なりとも速くなっているだろうと思います。
もし異なるtagNameのものも含めて抽出したい場合は、たとえばtagNameにvbNullStringを渡し、次のような使い分けをすればよいでしょう。
If tagName = vbNullString Then
結果的にはWebBrowserによる表示が不要なため、この変更で処理速度は格段に速くなりました。
補足
この例で生成する HtmlDocument にはいくつか制約があります。
・sectionなど非対応のtagはHTMLUnknownElementとなり、単独のElementとして作られるが、DOM構造からには含まれなず、getElementsByTagName、allなどのメソッド/プロパティーが使用できない。
・原因ははっきりしませんが、フリーズすることがありました。速度が速くなりすぎ、Excelの再描画追いつかないためかもしれません。そんなときは再描画の一時中止/再開を試してみてください。
Application.ScreenUpdating = False 再描画が発生する処理 Application.ScreenUpdating = True
