{"id":6086,"date":"2015-08-14T13:38:08","date_gmt":"2015-08-14T04:38:08","guid":{"rendered":"http:\/\/www.ka-net.org\/blog\/?p=6086"},"modified":"2015-09-29T13:50:22","modified_gmt":"2015-09-29T04:50:22","slug":"%e8%b5%b7%e5%8b%95%e4%b8%ad%e3%81%aemicrosoft-edge%e3%81%8b%e3%82%89%e3%82%bf%e3%82%a4%e3%83%88%e3%83%ab%e3%81%a8url%e3%82%92%e5%8f%96%e5%be%97%e3%81%99%e3%82%8bvba%e3%83%9e%e3%82%af%e3%83%addom","status":"publish","type":"post","link":"https:\/\/www.ka-net.org\/blog\/?p=6086","title":{"rendered":"\u8d77\u52d5\u4e2d\u306eMicrosoft Edge\u304b\u3089\u30bf\u30a4\u30c8\u30eb\u3068URL\u3092\u53d6\u5f97\u3059\u308bVBA\u30de\u30af\u30ed(DOM\u7de8)"},"content":{"rendered":"

\u524d\u56de\u306e\u8a18\u4e8b<\/a>\u3067\u3001UI Automation\u3092\u4f7f\u3063\u3066\u8d77\u52d5\u4e2d\u306eMicrosoft Edge\u304b\u3089\u30bf\u30a4\u30c8\u30eb\u3068URL\u3092\u53d6\u5f97\u3059\u308bVBA\u30de\u30af\u30ed\u3092\u7d39\u4ecb\u3057\u307e\u3057\u305f\u304c\u3001\u4ee5\u524d\u66f8\u3044\u305f\u8a18\u4e8b\u300cMicrosoft Edge\u3092\u64cd\u4f5c\u3059\u308bVBA\u30de\u30af\u30ed(DOM\u7de8)<\/a>\u300d\u3067Edge\u306e\u4e2d\u306b\u3042\u308bInternet Explorer_Server\u30a6\u30a3\u30f3\u30c9\u30a6\u304b\u3089HTMLDocument(JScriptTypeInfo\u3067\u3057\u305f\u304c\u2026)\u3092\u53d6\u5f97\u3067\u304d\u308b\u3053\u3068\u304c\u5206\u304b\u3063\u3066\u3044\u308b\u306e\u3067\u3001\u3053\u3061\u3089\u3092\u4f7f\u3063\u305f\u65b9\u304c\u697d\u306bEdge\u3067\u958b\u3044\u3066\u3044\u308b\u30da\u30fc\u30b8\u306e\u60c5\u5831\u3092\u53d6\u5f97\u3059\u308b\u3053\u3068\u304c\u3067\u304d\u307e\u3059\u3002<\/p>\n

2015\/9\/29 \u8ffd\u8a18\uff1a<\/span>
\n\u30b3\u30fc\u30c9\u306b\u4e00\u90e8\u4e0d\u5177\u5408\u304c\u3042\u3063\u305f\u306e\u3067\u4fee\u6b63\u3057\u307e\u3057\u305f\u3002<\/p>\n

\u203b \u4e0b\u8a18\u30b3\u30fc\u30c9\u306f64\u30d3\u30c3\u30c8\u7248Office\u3067\u306f\u52d5\u4f5c\u3057\u307e\u305b\u3093\u306e\u3067\u3001\u30b3\u30fc\u30c9\u3092\u66f8\u304d\u63db\u3048\u308b\u5fc5\u8981\u304c\u3042\u308a\u307e\u3059\u3002<\/span><\/p>\n

'\u6a19\u6e96\u30e2\u30b8\u30e5\u30fc\u30eb\r\nOption Explicit\r\n\r\nPrivate Type UUID\r\n  Data1 As Long\r\n  Data2 As Integer\r\n  Data3 As Integer\r\n  Data4(0 To 7) As Byte\r\nEnd Type\r\n\r\nPrivate Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, lParam As Long) As Long\r\nPrivate Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, lParam As Long) As Long\r\nPrivate Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long\r\nPrivate Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long\r\nPrivate Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long\r\nPrivate Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long\r\nPrivate Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, riid As Any, ByVal wParam As Long, ppvObject As Object) As Long\r\nPrivate Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long\r\nPrivate 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\r\nPrivate Const SMTO_ABORTIFHUNG = &H2\r\n\r\nPrivate hEdge As Long\r\n\r\nPublic Sub ListEdgeTabInfo()\r\n'\u8d77\u52d5\u4e2d\u306eEdge\u306e\u30bf\u30d6\u304b\u3089\u30bf\u30a4\u30c8\u30eb\u3068URL\u3092\u53d6\u5f97(64\u30d3\u30c3\u30c8\u7248Office\u3067\u306f\u4e0d\u53ef)\r\n'http:\/\/www.mvps.org\/emorcillo\/en\/code\/vb6\/iedom.shtml \u53c2\u7167\r\n  hEdge = 0 '\u521d\u671f\u5316\r\n  EnumWindows AddressOf EnumWindowsProc, 0\r\n  If hEdge = 0 Then Exit Sub\r\n  EnumChildWindows hEdge, AddressOf EnumChildProc, 0\r\nEnd Sub\r\n\r\nPrivate Function EnumWindowsProc(ByVal hWnd As Long, lParam As Long) As Long\r\n  Dim buf1 As String * 255\r\n  Dim buf2 As String * 255\r\n  Dim ClassName As String\r\n  Dim WindowName As String\r\n  Dim hTmp As Long\r\n  \r\n  hTmp = 0 '\u521d\u671f\u5316\r\n  If IsWindowVisible(hWnd) Then\r\n    GetClassName hWnd, buf1, Len(buf1)\r\n    ClassName = Left(buf1, InStr(buf1, vbNullChar) - 1)\r\n    Select Case ClassName\r\n      Case "ApplicationFrameWindow" '\u975e\u6700\u5c0f\u5316\u6642\r\n        hTmp = FindWindowEx(hWnd, 0, "Windows.UI.Core.CoreWindow", "Microsoft Edge")\r\n        If hTmp <> 0 Then\r\n          hEdge = hWnd\r\n          EnumWindowsProc = False\r\n          Exit Function\r\n        End If\r\n      Case "Windows.UI.Core.CoreWindow" '\u6700\u5c0f\u5316\u6642\r\n        GetWindowText hWnd, buf2, Len(buf2)\r\n        WindowName = Left(buf2, InStr(buf2, vbNullChar) - 1)\r\n        If WindowName = "Microsoft Edge" Then\r\n          hEdge = hWnd\r\n          EnumWindowsProc = False\r\n          Exit Function\r\n        End If\r\n    End Select\r\n  End If\r\n  EnumWindowsProc = True\r\nEnd Function\r\n\r\nPrivate Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Long\r\n  Dim buf As String * 255\r\n  Dim ClassName As String\r\n  Dim d As Object\r\n  \r\n  GetClassName hWnd, buf, Len(buf)\r\n  ClassName = Left(buf, InStr(buf, vbNullChar) - 1)\r\n  If ClassName = "Internet Explorer_Server" Then\r\n    Set d = GetHTMLDocumentFromWindow(hWnd)\r\n    If Not d Is Nothing Then\r\n      Debug.Print d.Title, d.Location.href\r\n    End If\r\n  End If\r\n  EnumChildProc = True\r\nEnd Function\r\n\r\nPrivate Function GetHTMLDocumentFromWindow(ByVal hWnd As Long) As Object\r\n  Dim msg As Long\r\n  Dim res As Long\r\n  Dim ret As Object\r\n  Dim d As Object\r\n  Dim IID_IHTMLDocument As UUID\r\n  \r\n  Set ret = Nothing '\u521d\u671f\u5316\r\n  msg = RegisterWindowMessage("WM_HTML_GETOBJECT")\r\n  SendMessageTimeout hWnd, msg, 0, 0, SMTO_ABORTIFHUNG, 1000, res\r\n  If res Then\r\n    With IID_IHTMLDocument\r\n      .Data1 = &H626FC520\r\n      .Data2 = &HA41E\r\n      .Data3 = &H11CF\r\n      .Data4(0) = &HA7\r\n      .Data4(1) = &H31\r\n      .Data4(2) = &H0\r\n      .Data4(3) = &HA0\r\n      .Data4(4) = &HC9\r\n      .Data4(5) = &H8\r\n      .Data4(6) = &H26\r\n      .Data4(7) = &H37\r\n    End With\r\n    If ObjectFromLresult(res, IID_IHTMLDocument, 0, d) = 0 Then Set ret = d\r\n  End If\r\n  Set GetHTMLDocumentFromWindow = ret\r\nEnd Function<\/pre>\n
\u4e0a\u8a18\u30b3\u30fc\u30c9\u3067\u3084\u3063\u3066\u3044\u308b\u3053\u3068\u306f\u300cMicrosoft Edge\u3092\u64cd\u4f5c\u3059\u308bVBA\u30de\u30af\u30ed(DOM\u7de8)<\/a>\u300d\u3068\u307b\u307c\u540c\u3058\u3067\u3001Internet Explorer_Server\u30a6\u30a3\u30f3\u30c9\u30a6\u3092\u63a2\u3057\u3066\u9806\u756a\u306bDOM\u64cd\u4f5c\u3092\u884c\u3063\u3066\u3044\u308b\u3060\u3051\u3067\u3059\u3002<\/p>\n
\u305f\u3060\u3001Edge\u304c\u6700\u5c0f\u5316\u3055\u308c\u3066\u3044\u308b\u5834\u5408\u306fApplicationFrameWindow\u306e\u5b50\u30a6\u30a3\u30f3\u30c9\u30a6\u304b\u3089Internet Explorer_Server\u30a6\u30a3\u30f3\u30c9\u30a6\u3092\u53d6\u5f97\u3059\u308b\u3053\u3068\u304c\u3067\u304d\u306a\u304b\u3063\u305f\u305f\u3081\u3001\u6700\u5c0f\u5316\u6642\u306e\u51e6\u7406\u306f\u5225\u306b\u3057\u3066\u3044\u307e\u3059\u3002<\/p>\n
\u95a2\u9023\u8a18\u4e8b<\/h4>\n