VBAでEdge操作を自動化してみた。
.NET Frameworkがインストールされていないと、実行時にオートメーションエラーが発生します。 オートメーションエラーが発生する場合、.NET Framework 3.5をインストールしてください。動画ではEdgeでの起動オプションが設定出来ないと言ってますが、 Edgeでの起動オプション変更方法が判明しました!
'ブラウザを起動
Dim driver As New Selenium.WebDriver
Set driver = CreateObject("Selenium.webDriver")
'Edgeに起動オプションをjsonで渡す
driver.SetCapability "ms:edgeOptions", "{""args"": [""user-data-dir=" & Replace(fso.BuildPath(CurrentDirectory, "edge_vba1"), "\", "\\") & """" & _
",""disable-blink-features=AutomationControlled""" & _
"] }"
driver.Start "edge"
VBAで作ったみた。
Option Explicit
#If Win64 Then
' Excel が64ビット版の場合の関数定義です。
Private Declare PtrSafe Function MessageBoxTimeoutA Lib "User32.dll" _
(ByVal hWnd As LongPtr, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal uType As VbMsgBoxStyle, _
ByVal wLanguageID As Long, _
ByVal dwMilliseconds As Long) As Long
#Else
' Excel が32ビット版の場合の関数定義です。
Private Declare Function MessageBoxTimeoutA Lib "User32.dll" _
(ByVal hWnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal uType As VbMsgBoxStyle, _
ByVal wLanguageID As Long, _
ByVal dwMilliseconds As Long) As Long
#End If
Sub Macro()
Dim driver, o_elem, fso, file, str_user, str_pass, CurrentDirectory, myBy, bFlag, num_trend_word, i
'パスワードファイルを読む
Set fso = CreateObject("Scripting.FileSystemObject")
CurrentDirectory = ActiveWorkbook.Path
Set file = fso.OpenTextFile(fso.BuildPath(CurrentDirectory, "pass1.txt"), 1)
str_user = file.ReadLine
str_pass = file.ReadLine
file.Close
Set file = Nothing
'Edgeブラウザを起動
Set driver = CreateObject("Selenium.webDriver")
'EdgeだとAddArgumentが動かない。pythonだと動く
driver.AddArgument "user-data-dir=" & fso.BuildPath(CurrentDirectory, "edge_vba")
driver.Start "Edge"
driver.Get "https://websearch.rakuten.co.jp/"
Set o_elem = driver.FindElementsByPartialLinkText("ログイン")
If o_elem.Count > 0 Then
'ログインしていない リンクをクリック
driver.ExecuteScript "arguments[0].click();", o_elem.Item(1)
'パスワード入力エリアが出現するまで待つ
Call WaitElementbyCss(driver, "#loginInner_p")
driver.FindElementByCss("#loginInner_p").SendKeys str_pass
driver.FindElementByCss("#loginInner_u").SendKeys str_user
driver.FindElementByCss("input.loginButton").Click
End If
'トレンドワードを配列に格納
Call WaitElementbyCss(driver, "div.TrendWord-module__trendWordWrap__19AOz input")
Set o_elem = driver.FindElementsByCss("div.TrendWord-module__trendWordWrap__19AOz input")
num_trend_word = o_elem.Count
Dim str_trend_word(5)
For i = 1 To num_trend_word
str_trend_word(i - 1) = o_elem.Item(i).Value
Next
'配列に格納されたトレンドワードを検索する
For i = 0 To num_trend_word
'検索窓にトレンドワードを入力する
Set o_elem = driver.FindElementsByCss("#search-input,#srchformtxt_qt")
o_elem.Item(1).Clear
o_elem.Item(1).SendKeys str_trend_word(i)
'検索ボタンを押す
Set o_elem = driver.FindElementsByCss("#search-submit,#searchBtn")
o_elem.Item(1).Click
MessageBoxTimeoutA 0&, "1秒後、自動に閉じます", "時間待ちです", 1, 65536, 1 * 1000
Next
'IEを閉じる
driver.Quit
Set driver = Nothing
End Sub
Sub WaitElementbyCss(driver, css)
Dim bFlag, myBy
bFlag = False
Set myBy = New By
Do
bFlag = driver.IsElementPresent(myBy.css(css))
driver.Wait 1000
Loop Until bFlag = True
End Sub
DOSバッチ・VBScriptで作ったみた。
<!-- :
@%windir%\System32\cscript.exe //nologo "%~f0?.wsf"
@exit /b %errorlevel%
-->
<job>
<script language="VBScript">
Dim driver, o_elem, fso, file, str_user, str_pass, CurrentDirectory, myBy, bFlag, num_trend_word, i
'パスワードファイルを読む
Set fso = CreateObject("Scripting.FileSystemObject")
CurrentDirectory = fso.getParentFolderName(WScript.ScriptFullName)
Set file = fso.OpenTextFile(fso.BuildPath(CurrentDirectory, "pass1.txt"), 1)
str_user = file.ReadLine
str_pass = file.ReadLine
file.Close
Set file = Nothing
'Edgeブラウザを起動
Set driver = WScript.CreateObject("Selenium.webDriver")
Set myBy = WScript.CreateObject("selenium.By")
'EdgeだとAddArgumentが動かない。pythonだと動く
driver.AddArgument "user-data-dir=" & fso.BuildPath(CurrentDirectory, "edge_vba")
driver.Start "Edge"
driver.Get "https://websearch.rakuten.co.jp/"
Set o_elem = driver.FindElementsByPartialLinkText("ログイン")
If o_elem.Count > 0 Then
'ログインしていない リンクをクリック
driver.ExecuteScript "arguments[0].click();", o_elem.Item(1)
'パスワード入力エリアが出現するまで待つ
Call WaitElementbyCss(driver, "#loginInner_p")
driver.FindElementByCss("#loginInner_p").SendKeys str_pass
driver.FindElementByCss("#loginInner_u").SendKeys str_user
driver.FindElementByCss("input.loginButton").Click
End If
'トレンドワードを配列に格納
Call WaitElementbyCss(driver, "div.TrendWord-module__trendWordWrap__19AOz input")
Set o_elem = driver.FindElementsByCss("div.TrendWord-module__trendWordWrap__19AOz input")
num_trend_word = o_elem.Count
Dim str_trend_word(5)
For i = 1 To num_trend_word
str_trend_word(i - 1) = o_elem.Item(i).Value
Next
'配列に格納されたトレンドワードを検索する
For i = 0 To num_trend_word
'検索窓にトレンドワードを入力する
Set o_elem = driver.FindElementsByCss("#search-input,#srchformtxt_qt")
o_elem.Item(1).Clear
o_elem.Item(1).SendKeys str_trend_word(i)
'検索ボタンを押す
Set o_elem = driver.FindElementsByCss("#search-submit,#searchBtn")
o_elem.Item(1).Click
WScript.CreateObject("WScript.Shell").popup "1秒後、自動に閉じます",1, "時間待ちです", 1
Next
'IEを閉じる
driver.Quit
Set driver = Nothing
Sub WaitElementbyCss(driver, css)
Dim bFlag, myBy
bFlag = False
Set myBy = WScript.CreateObject("Selenium.By")
Do
bFlag = driver.IsElementPresent(myBy.css(css))
driver.Wait 1000
Loop Until bFlag = True
End Sub
</script>
</job>
0件のコメント