{"id":7928,"date":"2017-02-01T15:40:20","date_gmt":"2017-02-01T06:40:20","guid":{"rendered":"https:\/\/www.ka-net.org\/blog\/?p=7928"},"modified":"2017-02-01T15:40:20","modified_gmt":"2017-02-01T06:40:20","slug":"%e3%80%902017%e5%b9%b41%e6%9c%88%e7%89%88%e3%80%91microsoft-edge%e3%82%92%e6%93%8d%e4%bd%9c%e3%81%99%e3%82%8bvba%e3%83%9e%e3%82%af%e3%83%addom%e7%b7%a82","status":"publish","type":"post","link":"https:\/\/www.ka-net.org\/blog\/?p=7928","title":{"rendered":"\u30102017\u5e741\u6708\u7248\u3011Microsoft Edge\u3092\u64cd\u4f5c\u3059\u308bVBA\u30de\u30af\u30ed(DOM\u7de8)(2)"},"content":{"rendered":"

\u6628\u65e5\u306e\u8a18\u4e8b<\/a>\u3067\u3001Microsoft Edge\u3092\u64cd\u4f5c\u3059\u308bVBA\u30b3\u30fc\u30c9\u3092\u6539\u3081\u3066\u66f8\u304d\u307e\u3057\u305f\u304c\u3001\u6628\u65e5\u306e\u30b3\u30fc\u30c9\u306f\u300cTabWindowClass<\/span>\u300d\u30af\u30e9\u30b9\u306e\u30a6\u30a3\u30f3\u30c9\u30a6\u3092\u6c7a\u3081\u6253\u3061\u3057\u3066\u3044\u308b\u306e\u3067\u3001Edge\u306e\u4ed5\u69d8\u5909\u66f4\u306b\u3088\u308a\u52d5\u4f5c\u3057\u306a\u304f\u306a\u308b\u53ef\u80fd\u6027\u304c\u3042\u308a\u307e\u3059\u3002
\n(VBA\u3067Edge\u3092\u64cd\u4f5c\u3059\u308b\u306e\u3092\u6b62\u3081\u308c\u3070\u826f\u3044\u3060\u3051\u306a\u3093\u3067\u3059\u304c\u30fb\u30fb\u30fb)<\/p>\n

\u305d\u3053\u3067\u4eca\u56de\u306f\u3084\u308a\u65b9\u3092\u5909\u3048\u3066\u3001\u8d77\u52d5\u4e2d\u306e\u30d7\u30ed\u30bb\u30b9\u304b\u3089Edge\u3092\u63a2\u3057\u3001\u305d\u306e\u5b50\u30a6\u30a3\u30f3\u30c9\u30a6\u306e\u4e2d\u304b\u3089\u300cInternet Explorer_Server<\/span>\u300d\u30af\u30e9\u30b9\u306e\u30a6\u30a3\u30f3\u30c9\u30a6\u3092\u53d6\u5f97\u3059\u308b\u65b9\u6cd5\u3092\u8003\u3048\u3066\u307f\u307e\u3057\u305f\u3002<\/p>\n

'\u6a19\u6e96\u30e2\u30b8\u30e5\u30fc\u30eb\r\nOption Explicit\r\n \r\nPrivate Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, lParam As Long) 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 GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hWnd As Long, ByVal wFlag As Long) As Long\r\nPrivate Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long\r\nPrivate Declare Function GetTopWindow Lib "user32" (ByVal hWnd As Long) As Long\r\nPrivate Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long\r\nPrivate Declare Function IIDFromString Lib "ole32" (lpsz As Any, lpiid As Any) 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 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)\r\nPrivate Const GW_HWNDNEXT = &H2\r\nPrivate hIES As Long\r\n\r\nPublic Sub Sample_EdgeDOM2()\r\n'Microsoft Edge\u3092DOM\u64cd\u4f5c(64\u30d3\u30c3\u30c8\u7248Excel\u3067\u306f\u30b3\u30fc\u30c9\u8981\u5909\u66f4)\r\n'\u203b\u4e0b\u8a18\u30da\u30fc\u30b8\u53c2\u7167\r\n'http:\/\/www.mvps.org\/emorcillo\/en\/code\/vb6\/iedom.shtml\r\n'http:\/\/kchon.blog111.fc2.com\/blog-entry-128.html\r\n'http:\/\/d.hatena.ne.jp\/yu-hr\/20100323\/1269355469\r\n'https:\/\/blogs.msdn.microsoft.com\/oldnewthing\/20151015-00\/?p=91351\r\n'\r\n'\u203b\u4e0b\u8a18\u74b0\u5883\u3067\u52d5\u4f5c\u78ba\u8a8d\r\n'Microsoft Windows 10 Pro Insider Preview \u30d0\u30fc\u30b8\u30e7\u30f3:10.0.15019 \u30d3\u30eb\u30c9 15019\r\n'Microsoft Edge 40.15019.1000.0\r\n'Microsoft Excel 2016 MSO (16.0.7668.7078) 32 \u30d3\u30c3\u30c8\r\n  \r\n  Dim con As Object, items As Object, d As Object\r\n  Dim hWnd As Long, pid As Long\r\n  Const ProcessName = "MicrosoftEdgeCP.exe"\r\n  \r\n  '\u521d\u671f\u5316\r\n  hIES = 0\r\n  \r\n  'Edge\u8d77\u52d5\r\n  CreateObject("Shell.Application").ShellExecute "microsoft-edge:http:\/\/www.yahoo.co.jp\/"\r\n  Sleep 3000\r\n  \r\n  Set con = CreateObject("WbemScripting.SWbemLocator").ConnectServer\r\n  hWnd = GetTopWindow(0)\r\n  Do\r\n    If GetParent(hWnd) = 0 Then\r\n      '\u30a6\u30a3\u30f3\u30c9\u30a6\u30cf\u30f3\u30c9\u30eb\u304b\u3089\u30d7\u30ed\u30bb\u30b9ID\u3092\u53d6\u5f97\u3057\u3001Edge\u306e\u30a6\u30a3\u30f3\u30c9\u30a6\u304b\u3069\u3046\u304b\u3092\u5224\u5225\u3059\u308b\r\n      GetWindowThreadProcessId hWnd, pid\r\n      Set items = con.ExecQuery("Select * From Win32_Process Where (ProcessId = '" & pid & "') And (Name = '" & ProcessName & "')")\r\n      If items.Count > 0 Then\r\n        'Edge\u306e\u5b50\u30a6\u30a3\u30f3\u30c9\u30a6\u5217\u6319\r\n        EnumChildWindows hWnd, AddressOf EnumChildProcIES, 0\r\n        If hIES <> 0 Then Exit Do\r\n      End If\r\n    End If\r\n    hWnd = GetNextWindow(hWnd, GW_HWNDNEXT)\r\n  Loop While hWnd <> 0\r\n  If hIES = 0 Then Exit Sub\r\n  \r\n  Set d = GetHTMLDocumentFromIES(hIES)\r\n  If Not d Is Nothing Then\r\n    'DOM\u64cd\u4f5c\r\n    d.getElementById("srchtxt").Value = "\u521d\u5fc3\u8005\u5099\u5fd8\u9332\u30d6\u30ed\u30b0"\r\n    d.getElementById("srchbtn").Click\r\n    While LCase(d.ReadyState) <> "complete"\r\n      Sleep 100\r\n    Wend\r\n    MsgBox d.Title, vbInformation + vbSystemModal\r\n  End If\r\nEnd Sub\r\n\r\nPrivate Function EnumChildProcIES(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   \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    hIES = hWnd\r\n    EnumChildProcIES = False\r\n    Exit Function\r\n  End If\r\n  EnumChildProcIES = True\r\nEnd Function\r\n\r\nPrivate Function GetHTMLDocumentFromIES(ByVal hWnd As Long) As Object\r\n  Dim msg As Long, res As Long\r\n  Dim iid(0 To 3) As Long\r\n  Dim ret As Object, obj As Object\r\n  Const SMTO_ABORTIFHUNG = &H2\r\n  Const IID_IHTMLDocument2 = "{332C4425-26CB-11D0-B483-00C04FD90119}"\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    IIDFromString StrPtr(IID_IHTMLDocument2), iid(0)\r\n    If ObjectFromLresult(res, iid(0), 0, obj) = 0 Then Set ret = obj\r\n  End If\r\n  Set GetHTMLDocumentFromIES = ret\r\nEnd Function<\/pre>\n
\"\"<\/p>\n
\u30d7\u30ed\u30bb\u30b9\u306e\u7279\u5b9a\u51e6\u7406\u90e8\u5206\u304c\u91cd\u3044\u306e\u304c\u96e3\u70b9\u3067\u3059\u304c\u3001\u3053\u306e\u65b9\u6cd5\u3067\u3042\u308c\u3070\u591a\u5c11Edge\u306e\u69cb\u9020\u304c\u5909\u308f\u3063\u305f\u3068\u3057\u3066\u3082\u3001Internet Explorer_Server\u30af\u30e9\u30b9\u306e\u30a6\u30a3\u30f3\u30c9\u30a6\u3092\u6301\u3063\u3066\u3044\u308b\u9650\u308a\u3001DOM\u64cd\u4f5c\u3067\u304d\u308b\u306f\u305a\u3067\u3059\u3002<\/p>\n
\u3068\u306f\u3044\u3063\u3066\u3082\u3001\u4f55\u5ea6\u3082\u8a00\u3063\u3066\u3044\u308b\u901a\u308a\u4e0a\u8a18\u306e\u3088\u3046\u306a\u65b9\u6cd5\u306fMicrosoft\u304c\u63a8\u5968\u3057\u3066\u3044\u308b\u65b9\u6cd5\u3067\u306f\u7121\u3044\u305f\u3081\u3001\u4f55\u306e\u4fdd\u8a3c\u3082\u3042\u308a\u307e\u305b\u3093\u3002
\n\u8a00\u8a9e\u554f\u308f\u305a\u3001Microsoft Edge\u306e\u64cd\u4f5c\u3092\u81ea\u52d5\u5316\u3057\u305f\u3044\u5834\u5408\u306f\u3001\u7d20\u76f4\u306b\u300cWebDriver<\/a>\u300d\u3092\u4f7f\u3046\u306e\u304c\u826f\u3044\u3067\u3057\u3087\u3046\u3002<\/p>\n
\n
\n