VBAでEdge操作を自動化してみた

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>

コメントを残す コメントをキャンセル

コメントを残すコメントをキャンセル