none
IEのサポートが2022年6月15日に終了とのことですがVBAの対応方法は? RRS feed

  • 質問

  • これまで、「Set objIE = CreateObject("InternetExplorer.Application")」などを使ってIEを立ち上げてdocument内のデータを取得したりするVBAマクロを作って、便利に使ってきたのでしたが、後1年ほどでサポートが切れるとのニュースが流れてきました。
    https://www.msn.com/ja-jp/news/techandscience/microsoft-ie-internet-explorer-%E3%82%B5%E3%83%9D%E3%83%BC%E3%83%88%E7%B5%82%E4%BA%86%E3%81%AF2022%E5%B9%B46%E6%9C%8815%E6%97%A5/ar-AAKaCD5?ocid=msedgntp

    Microsoftさんはvbaで利用できる何らかの代わりの分かりやすい方法をご用意いただけるのでしょうか?

    それが期待できないとすると、vbaマクロを改修する方法として、どのような対処方法が考えられるでしょうか?対処方法がいくつかあるとすれば、それぞれのメリットとデメリットはどんなものなのでしょうか?

    これまでもネット検索などしてみたものの、今一つ良く分からないものですから、教えていただけると大変助かります。

    2021年5月20日 5:57

回答

  • 続報に期待。

    CreateObject("InternetExplorer.Application") が生き残るかどうかについては情報を持ち合わせていませんが

    続報です。

    オートメーションによる IE11 起動はできずに ChronuimEdge にリダイレクトされ、かつ、ShellWindows でも IE モードは列挙できないそうです。

    ただし API を使えば、操作対象の Internet Explorer_Server のウィンドウハンドルから、IE モードで表示されている IHTMLDocument を得る事が出来ます。

    ウィンドウハンドルから IHTMLDocument を得るための VBA コードを載せておきます。

    Option Explicit
    
    Private Declare PtrSafe Function CLSIDFromString Lib "ole32" (ByVal pString As LongPtr, ByRef pCLSID As Currency) As Long
    Private Declare PtrSafe Function RegisterWindowMessageW Lib "user32" (ByVal lpString As LongPtr) As Long
    Private Declare PtrSafe Function SendMessageTimeoutW Lib "user32" (ByVal hWnd As LongPtr, ByVal msg As Long, ByVal wParam As LongPtr, ByRef lParam As LongPtr, ByVal fuFlags As Long, ByVal uTimeout As Long, ByRef lpdwResult As Long) As LongPtr
    Private Declare PtrSafe Function ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, ByRef riid As Currency, ByVal wParam As LongPtr, ppvObject As Any) As Long
    Private Enum SMTO
        NORMAL = 0
        BLOCK = 1
        ABORTIFHUNG = 2
        NOTIMEOUTIFNOTHUNG = 8
    End Enum
    
    ' Internet Explorer_Server ウィンドウのハンドルから HTMLDocument オブジェクトを取得する
    '
    ' 第 1 引数: InternetExplorer_Server のウィンドウハンドル
    ' 第 2 引数: 省略可能(タイムアウト時間)
    ' 第 3 引数: 省略可能(1:IHTMLDocument~8:IHTMLDocument8)
    Public Function GetHtmlDocument(ByVal hWnd_InternetExplorer_Server As LongPtr, Optional ByVal uTimeout As Long = 1000, Optional ByVal documentVersion As Integer = 1) As Object  ' As MSHTML.IHTMLDocument
        Set GetHtmlDocument = Nothing
        
        If documentVersion <= 0 Then
            documentVersion = 1
        ElseIf documentVersion >= 8 Then
            documentVersion = 8
        End If
        Dim IID_IHTMLDocumentX As String
        IID_IHTMLDocumentX = Split(",{626FC520-A41E-11cf-A731-00A0C9082637},{332c4425-26cb-11d0-b483-00c04fd90119},{3050f485-98b5-11cf-bb82-00aa00bdce0b},{3050f69a-98b5-11cf-bb82-00aa00bdce0b},{3050f80c-98b5-11cf-bb82-00aa00bdce0b},{30510417-98b5-11cf-bb82-00aa00bdce0b},{305104b8-98b5-11cf-bb82-00aa00bdce0b},{305107d0-98b5-11cf-bb82-00aa00bdce0b}", ",")(documentVersion - 1)
        Dim InterfaceId(1) As Currency
        Call CLSIDFromString(StrPtr(IID_IHTMLDocumentX), InterfaceId(0))
        
        Dim lngMsg As Long
        lngMsg = RegisterWindowMessageW(StrPtr("WM_HTML_GETOBJECT"))
        If lngMsg <> 0 Then
            Dim lpdwResult As Long
            If SendMessageTimeoutW(hWnd_InternetExplorer_Server, lngMsg, 0, 0, SMTO.ABORTIFHUNG, uTimeout, lpdwResult) <> 0 Then
                Dim hResult As Long
                hResult = ObjectFromLresult(lpdwResult, InterfaceId(0), 0, GetHtmlDocument)
                If hResult <> 0 Then
                    Err.Raise hResult
                End If
            End If
        End If
    End Function
    2021年5月21日 3:37

すべての返信

  • Power Automete に置き換える、VBA から Selenium を使う、などは候補でしょうね。


    Hebikuzure aka Murachi Akira

    2021年5月20日 8:18
  • Hebikuzure aka Murachi Akiraさん、今晩は。

    ご返事、ありがとうございます。

    ただ、Power Automateは、有償みたいですから、貧乏人の小生にはちょっとね、という感じがしますし、かつ、VBAとは別物みたいですから、一から作り替えるようになるのではないでしょうか?

    一方、Seleniumは、Microsoftさんが提供されているものではないみたいですし、他社提供のツールを使ったらいいんじゃない?というのは、何ともExcel等のVBAを提供している会社としては無責任な対応のように思うのですが、ちょっと頭が固すぎますかねぇ。

    それ以外には、無いのでしょうか?

    いずれにしても、後1年のうちに、代替方策について必要な知識を身に着けて対応しなければならないとは、なかなか骨の折れることですね。

    2021年5月20日 9:27
  • VBA はまだマシで… WSH 界隈の方がインパクトは大きいかも?
    HTA はどうなるんでしょうね。続報に期待。

    CreateObject("InternetExplorer.Application") が生き残るかどうかについては情報を持ち合わせていませんが、どうやら WebBrowser は引き続きサポートされる そうなので、要件次第ではこれが代替となるかもしれません。

    とはいえ VBA のバージョンや 32bit / 64bit の問題もあるので、すべての VBA が WebBrowser をサポートするかどうかは別問題。

    定番の Selenium も、IE 版の WebDriver が使えなくなるかな…。

    https://note.com/teihen_escape/n/n40e672b1c97f
    https://www.teradas.net/archives/23662/

    2021年5月20日 10:32
  • Excel から IE をどのように使っているか次第ですが、Web サイトにアクセスさせるといった使い方なら、どちらかと言えば、Web サイト側が IE に対応しない、IE を拒絶するという未来の方が早いかもしれません。

    COM の IE コンポーネントは、Microsoft Edge の IE モードのサポートを保証している  2029 年頃までそのままの可能性もありえますが、逆に言えば、Web サイトが正常にレンダリングできなくなっていくリスクもあります。
    IE に依存しない方法を学ぶ、探っていくことは、自衛措置として必要でしょうね。
    (2015 年ごろに Microsoft Edge 開発へ舵を切ったときから、そのリスクは存在していましたので、6 年越しで「いよいよ来たか」というところですね)

    2021年5月20日 11:27
  • 続報に期待。

    CreateObject("InternetExplorer.Application") が生き残るかどうかについては情報を持ち合わせていませんが

    続報です。

    オートメーションによる IE11 起動はできずに ChronuimEdge にリダイレクトされ、かつ、ShellWindows でも IE モードは列挙できないそうです。

    ただし API を使えば、操作対象の Internet Explorer_Server のウィンドウハンドルから、IE モードで表示されている IHTMLDocument を得る事が出来ます。

    ウィンドウハンドルから IHTMLDocument を得るための VBA コードを載せておきます。

    Option Explicit
    
    Private Declare PtrSafe Function CLSIDFromString Lib "ole32" (ByVal pString As LongPtr, ByRef pCLSID As Currency) As Long
    Private Declare PtrSafe Function RegisterWindowMessageW Lib "user32" (ByVal lpString As LongPtr) As Long
    Private Declare PtrSafe Function SendMessageTimeoutW Lib "user32" (ByVal hWnd As LongPtr, ByVal msg As Long, ByVal wParam As LongPtr, ByRef lParam As LongPtr, ByVal fuFlags As Long, ByVal uTimeout As Long, ByRef lpdwResult As Long) As LongPtr
    Private Declare PtrSafe Function ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, ByRef riid As Currency, ByVal wParam As LongPtr, ppvObject As Any) As Long
    Private Enum SMTO
        NORMAL = 0
        BLOCK = 1
        ABORTIFHUNG = 2
        NOTIMEOUTIFNOTHUNG = 8
    End Enum
    
    ' Internet Explorer_Server ウィンドウのハンドルから HTMLDocument オブジェクトを取得する
    '
    ' 第 1 引数: InternetExplorer_Server のウィンドウハンドル
    ' 第 2 引数: 省略可能(タイムアウト時間)
    ' 第 3 引数: 省略可能(1:IHTMLDocument~8:IHTMLDocument8)
    Public Function GetHtmlDocument(ByVal hWnd_InternetExplorer_Server As LongPtr, Optional ByVal uTimeout As Long = 1000, Optional ByVal documentVersion As Integer = 1) As Object  ' As MSHTML.IHTMLDocument
        Set GetHtmlDocument = Nothing
        
        If documentVersion <= 0 Then
            documentVersion = 1
        ElseIf documentVersion >= 8 Then
            documentVersion = 8
        End If
        Dim IID_IHTMLDocumentX As String
        IID_IHTMLDocumentX = Split(",{626FC520-A41E-11cf-A731-00A0C9082637},{332c4425-26cb-11d0-b483-00c04fd90119},{3050f485-98b5-11cf-bb82-00aa00bdce0b},{3050f69a-98b5-11cf-bb82-00aa00bdce0b},{3050f80c-98b5-11cf-bb82-00aa00bdce0b},{30510417-98b5-11cf-bb82-00aa00bdce0b},{305104b8-98b5-11cf-bb82-00aa00bdce0b},{305107d0-98b5-11cf-bb82-00aa00bdce0b}", ",")(documentVersion - 1)
        Dim InterfaceId(1) As Currency
        Call CLSIDFromString(StrPtr(IID_IHTMLDocumentX), InterfaceId(0))
        
        Dim lngMsg As Long
        lngMsg = RegisterWindowMessageW(StrPtr("WM_HTML_GETOBJECT"))
        If lngMsg <> 0 Then
            Dim lpdwResult As Long
            If SendMessageTimeoutW(hWnd_InternetExplorer_Server, lngMsg, 0, 0, SMTO.ABORTIFHUNG, uTimeout, lpdwResult) <> 0 Then
                Dim hResult As Long
                hResult = ObjectFromLresult(lpdwResult, InterfaceId(0), 0, GetHtmlDocument)
                If hResult <> 0 Then
                    Err.Raise hResult
                End If
            End If
        End If
    End Function
    2021年5月21日 3:37
  • Selenium は OSS で、最近の Microsoft は OSS で利用できる有用なツールがあればそれを活用するというスタンスですから、Selenium でできることにあえて独自のテクノロジーを持ち出さないといことでしょう。

    Power Automate は(Power Automete Desktop のように)無償で利用できる範囲もありますから、要件次第ですが追加費用はかからない可能性も十分にあります。


    Hebikuzure aka Murachi Akira

    2021年5月21日 6:03
  • Hebikuzure aka Murachi Akiraさま、 魔界の仮面弁士さま、Azuleanさま、ご返事ありがとうございます。

    魔界の仮面弁士さまには、コードまでご提示いただき、誠にありがとうございます。残念ながら悲しいことに、コードの意味を理解するには小生の知識レベルが低くて、今のところよく理解できていないのですが、少なくともこの関数でウィンドウハンドルからドキュメントが取得できるということですので、大変心強く思いました。

    ただ、目的のURLを開いて取得するべきドキュメントを開いた状態にするのにはどうすればよいのか、がわからず、また、「getElementById」とか「URLDownloadToFile()」とかは使えるのだろうか、とか心配の種は尽きません。引き続き、いろいろ勉強しながら、ぼちぼち作り変えを始めることが肝心だと考えているところです。小生にとっては問題解決というわけではありませんけれど、投稿から1週間が経ち、とりあえず現在のところはこんな感じで一段落とすべきなのかな、と思います。皆様、ありがとうございました。

    なお、その後の続報などもありましたら追加していただければありがたいです。よろしくお願いします。

    2021年5月27日 5:59
  • 小生も知識不足で難しいことに限らず基本も理解出来ておらず、恥ずかしながらコピペレベルで投稿し恐縮です。
    Chromium版EdgeのIEモードに対しては、ネットで公開されておられる諸氏のコードを参考にトライしてみたところ、特別なドライバー等を用いず、偶然なのかDOM操作が出来ました。(間違っておればご容赦ください、自信はありませんが何かの参考になればと、また諸氏への感謝の気持ちから勇気を持って10年ぶり投稿)
    ポイント
    ・ウィンドウハンドルからプロセスIDを取得し、プロセス名を使用してEdgeのウィンドウかを判断
    ・Edgeの子ウィンドウ列挙ではClassNameが、"Internet Explorer_Server"であることをもってハンドル取得
    ・上記より、IHTMLDocument2でオブジェクト取得し、オブジェクト.getElementById("@@@").Click/.Value="aaa"等が可能
    お役に立てば、また、ご指導等いただければ幸いです。

    実際のコード(要点)

    Option Explicit

    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function GetTopWindow Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
    Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, lParam As Long) As Long
    Private Const GW_HWNDNEXT = &H2
    Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hWnd As Long, ByVal wFlag As Long) As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function IIDFromString Lib "ole32" (lpsz As Any, lpiid As Any) As Long
    Private hIES As Long
    Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
    Private Const SMTO_ABORTIFHUNG = &H2
    Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hWnd As Long, ByVal msg As Long, _
                                ByVal wParam As Long, ByVal lParam As Long, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
    Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, riid As Any, ByVal wParam As Long, ppvObject As Object) As Long

    Private Type UUID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(0 To 7) As Byte
    End Type

    Public Sub IE_EdgeDOM()
    'Chromium版EdgeのIEモードをDOM操作(32ビット版Excel)
        Dim con As Object, items As Object
        Dim hWnd As Long, pId As Long
        Const ProcessName = "msedge.exe" '"従来版なら:MicrosoftEdgeCP.exeでしょうか"

        Dim msg As Long
        Dim res As Long
        Dim IID_IHTMLDocument2 As UUID
        Dim d As Object

    '------------------------------------------------------------------
    'IEモードのEdgeで起動する所定のサイトがある場合は、ショートカットリンクが便利
    '    Dim ch As Variant
    '    Dim URL As String
    '    Set ch = CreateObject("WScript.Shell")
    '       '第2引数でアクティブに(多分、ここ重要)、第3引数は不要
    '        ch.Run ("\\@@@@\@@@@.lnk"), 3
    '    Set ch = Nothing
    '    Sleep 2000
    '------------------------------------------------------------------
    '既に起動されていれば、上記ショートカットリンクの部分は不要
        Set con = CreateObject("WbemScripting.SWbemLocator").ConnectServer
        hWnd = GetTopWindow(0)
            Do
                If GetParent(hWnd) = 0 Then
                    'ウィンドウハンドルからプロセスIDを取得し、プロセス名を使用してEdgeのウィンドウかどうかを判別する
                    GetWindowThreadProcessId hWnd, pId
                    Set items = con.ExecQuery("Select * From Win32_Process Where (ProcessId = '" & pId & "') And (Name = '" & ProcessName & "')")
                    If items.Count > 0 Then
                        'Edgeの子ウィンドウ列挙
                        EnumChildWindows hWnd, AddressOf EnumChildProcIES, 0
                        If hIES <> 0 Then Exit Do
                    End If
                End If
                hWnd = GetNextWindow(hWnd, GW_HWNDNEXT)
            Loop While hWnd <> 0

        If hIES = 0 Then Exit Sub

        'IHTMLDocument2取得
        msg = RegisterWindowMessage("WM_HTML_GETOBJECT")
        SendMessageTimeout hIES, msg, 0, 0, SMTO_ABORTIFHUNG, 1000, res
        If res Then
            With IID_IHTMLDocument2
                .Data1 = &H332C4425
                .Data2 = &H26CB
                .Data3 = &H11D0
                .Data4(0) = &HB4
                .Data4(1) = &H83
                .Data4(2) = &H0
                .Data4(3) = &HC0
                .Data4(4) = &H4F
                .Data4(5) = &HD9
                .Data4(6) = &H1
                .Data4(7) = &H19
            End With

            If ObjectFromLresult(res, IID_IHTMLDocument2, 0, d) = 0 Then
                'DOM操作
    '            d.getElementById("@@@@@@@").Value = @@@@@
    '            d.getElementById("@@@@@@@").Click
                While LCase(d.readyState) <> "complete"
                    Sleep 2000
                Wend


            End If
        End If

    End Sub

    Private Function EnumChildProcIES(ByVal hWnd As Long, ByVal lParam As Long) As Long
      Dim buf As String * 255
      Dim ClassName As String

      GetClassName hWnd, buf, Len(buf)
      ClassName = Left(buf, InStr(buf, vbNullChar) - 1)
      If ClassName = "Internet Explorer_Server" Then
        hIES = hWnd
        EnumChildProcIES = False
        Exit Function
      End If
      EnumChildProcIES = True
    End Function

    2021年7月1日 15:14
  • 山田 太郎2さま、こんにちは。

    投稿、ありがとうございます。

    一旦解決済みとしたテーマですが、先が限られているIEにこだわらずに、Edgeを操作してドキュメントを取得して処理するような方策も代替策としては将来性が有るのではないか、もっといろいろな方策について投稿を待った方が良かったのではないか?、と考え始めて、解決済みにしたことをちょっと後悔していたところでした。

    小生の知らなかった「WbemScripting.SWbemLocator」を使った方法なので、残念ながら恥ずかしながら、すぐには理解不能ですが、追って勉強していきたいと思います。

    2021年7月2日 1:03