カテゴリー: VBA

カテゴリー
VBA

VBA/Seleniumでログイン処理

VBA/Seleniumでログイン処理

ログインする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
    
    'パスワードファイルを読む
    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

    
    'クロームブラウザを起動
    Set Driver = CreateObject("Selenium.WebDriver")
    Driver.AddArgument ("user-data-dir=" & fso.BuildPath(CurrentDirectory, "chrome_vba"))
    Driver.Start "chrome"
    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)
        'パスワード入力エリアが出現するまで待つ
        bFlag = False
        Set myBy = New By
        Do
            bFlag = Driver.IsElementPresent(myBy.Css("#loginInner_p"))
            Driver.Wait 1000
        Loop Until bFlag = True
        
        Driver.FindElementByCss("#loginInner_p").SendKeys str_pass
        Driver.FindElementByCss("#loginInner_u").SendKeys str_user
        Driver.FindElementByCss("input.loginButton").Click
    End If

    MessageBoxTimeoutA 0, "15秒後、自動に閉じます", "時間待ちです", 1, 65536, 15 * 1000
    
    'IEを閉じる
    Driver.Quit
    Set Driver = Nothing
End Sub
カテゴリー
VBA VBScript

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

VBA100本ノックの100本目をやってみた。

.NET Frameworkがインストールされていないと、実行時にオートメーションエラーが発生します。 オートメーションエラーが発生する場合、.NET Framework 3.5をインストールしてください。
VBAで作ったみた。 
Sub Macro()
    'クロームブラウザを起動
    Dim Driver, o_elem, i, num_trend_word
    Set Driver = CreateObject("Selenium.WebDriver")
    Driver.Start "chrome"
    Driver.Get "https://websearch.rakuten.co.jp/"

    'トレンドワードを配列に格納
    Set o_elem = Driver.FindElementsByCss("input.TrendWord-module__trendWordText__1uZER")
    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 = 1 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&, "5秒後、自動に閉じます", "時間待ちです", 1, 65536, 5 * 1000
    Next
    
    'IEを閉じる
    Driver.Quit
    Set Driver = Nothing
End Sub

DOSバッチ・VBScriptで作ったみた。 
<!-- :
@%windir%\System32\cscript.exe //nologo "%~f0?.wsf"
@exit /b %errorlevel%
-->
<job>
<script language="VBScript">
	'IEを起動する
	Set Driver = WScript.CreateObject("Selenium.WebDriver")
	Driver.Start "chrome"  'クロームブラウザを立ち上げます。
	Driver.Get "https://websearch.rakuten.co.jp/"

	'トレンドワードを配列に格納
	Set o_elem = Driver.FindElementsByCss("input.TrendWord-module__trendWordText__1uZER")
	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 = 1 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 "5秒後、自動に閉じます",5, "時間待ちです", 1
	Next
	'IEを閉じる
	Driver.Quit
	Set Driver = Nothing
</script>
</job>