カテゴリー
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

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください