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
0件のコメント