VBAで自動ツイート　第2弾！！

プログラムってコンパクトにまとまってくると、
あれ？あれだけ頑張ったけど大した事やってないんじゃね？
ってゆう感覚になるのは自分だけでしょうか？

はい、というわけで
前回作ったVBAマクロをクラスモジュールを使ってまとめてみました。
部品化？（と言っていいか分からんけど）できた時はチョー気持ちいいねｗ

クラスモジュールでコード書いていけるほどではないので標準モジュールで分けていってからクラスモジュールに移しました。
一回基本から勉強しようかと思ったけど楽しくて止められなかったー
理解度は中途半端です( ´∀｀ )

まず宣言のとこ。
前置きとして正しいかは不明。
動くから正しいってことでｗｗｗ

メインのとこ

短い  ( ´∀｀ )
こういうのがめっちゃ楽しい。

というわけで以下メインのモジュールです。
（めんどくさくなった（笑））

Option Explicit
    
    Public myChrome         As New OperationCromeDriver
    
    Public roguinURL        As String
    Public userNameXPath    As String
    Public passwordXPath    As String
    Public addressXPath     As String
    Public checkText1XPath  As String
    Public checkText1       As String
    Public userName         As String
    Public password         As String
    Public address          As String
    
    Public newTweetXPath    As String
    Public tweetBoxXPath    As String
    Public tweetButtonXPath As String
    Public tweetText        As String
    
Sub Twitterマクロ()

    Call 初期設定
    
    Call Twitterログイン
    Stop
    
    Call 新規ツイート投稿
    Stop
    
End Sub

Sub 初期設定()
    
    Dim wb        As Workbook
    Dim wsRoguin  As Worksheet
    Dim wsTweet   As Worksheet

    Set wb = ThisWorkbook
    Set wsRoguin = wb.Worksheets("ログイン")
    Set wsTweet = wb.Worksheets("新規ツイート")
   
    roguinURL = wsRoguin.Range("C4").Value              'ツイッターのログインページURL'
    addressXPath = wsRoguin.Range("C11").Value          'メールアドレス入力ボックスのXPath'
    checkText1XPath = wsRoguin.Range("C17").Value        '「電話番号またはユーザー名を入力」のテキスト表示のXPath'
    checkText1 = wsRoguin.Range("C8").Value             'ログイン時にユーザー名を聞かれた場合のチェックテキスト'
    userNameXPath = wsRoguin.Range("C12").Value         'ユーザー名入力ボックスのxPath'
    passwordXPath = wsRoguin.Range("C13").Value         'パスワードの入力ボックスのxPath'
    
    address = wsRoguin.Range("C6").Value                'ログイン時のアドレス'
    userName = wsRoguin.Range("C7").Value               'ログイン時のユーザー名'
    password = wsRoguin.Range("C8").Value               'ログイン時のパスワード'
    
    newTweetXPath = wsTweet.Range("C10").Value          '新規ツイートボタンのXPath'
    tweetBoxXPath = wsTweet.Range("C11").Value          'tweet内容入力ボックスXPath'
    tweetButtonXPath = wsTweet.Range("C12").Value       'tweet投稿ボタンのXPath'
    tweetText = wsTweet.Range("C6").Value               'tweet本文の内容'

End Sub


Sub Twitterログイン()
    With myChrome
    
        .DriverUrlSet roguinURL                        'ログイン画面開く'
    
        .XPathCheck addressXPath
        .TextInput addressXPath, address               'メールアドレスの入力'
    
        .XPathCheck userNameXPath, passwordXPath
        If .textCheck(checkTextXPath, checkText1) = True Then
            .TextInput userNameXPath, userName         'ユーザー名の入力'
        End If
        
        .XPathCheck passwordXPath
        .TextInput passwordXPath, password             'パスワードの入力'
    
    End With
End Sub

Sub 新規ツイート投稿()
    With myChrome
    
        .XPathCheck newTweetXPath
        .PushButton newTweetXPath                      '新規ツイートボタン'
    
        .XPathCheck tweetBoxXPath
        .TextInput tweetBoxXPath, tweetText            'ツイート内容入力'
    
        .XPathCheck tweetButtonXPath
        .PushButton tweetButtonXPath                   'ツイートする'
        
    End With
End Sub

ほとんどXPathあるか確認してInputボックスにテキスト張り付けて実行か、要素のボタンクリックするだけやから同じ作業ばっかりやなってことでまとめると短くなっていった。

Option Explicit

Public Driver    As New Selenium.WebDriver
Public elm       As Selenium.WebElement
Public skey      As New Selenium.Keys
Public myBy      As New By


Sub DriverUrlSet(URL)

    Driver.AddArgument "disable-gpu"                        'ウインドウサイズを最大化で開く'
    Driver.AddArgument "start-maximized"                    '同上'
    
    Driver.Start "chrome"
    Driver.Wait 2000
    Driver.Get URL                                 'ツイッターのログインページ開く'
    Driver.Wait 2000


End Sub

 
Sub XPathCheck(ByVal checkXPath1 As String, Optional checkXPath2 As String = "nothingXPath")
    
    
    Dim i As Long: i = 0
    
    Dim Flag As Boolean: Flag = False
    
    Do
        Driver.Wait 500
        
        Flag = Driver.IsElementPresent(myBy.XPath(checkXPath1)) Or _
                  Driver.IsElementPresent(myBy.XPath(checkXPath2))
        Driver.Wait 2000
        
        i = i + 1
        If i = 50 Then
            MsgBox "処理が継続できません。終了します。"
            End
        End If
        
    Loop Until Flag = True

End Sub


Sub TextInput(ByVal InputXPath As String, ByVal InputText As String)

    Set elm = Driver.FindElementByXPath(InputXPath)      '入力ボックスのxPath'
    
    elm.Clear
    elm.Click
    elm.SendKeys InputText                               '入力内容'
    elm.SendKeys skey.Enter
    
    Driver.Wait 1000

End Sub

Sub PushButton(ByVal ButtonXPath As String)

    Set elm = Driver.FindElementByXPath(ButtonXPath)      'ボタン要素のXPath'
    
    elm.Click
    
    Driver.Wait 1000

End Sub

Function textCheck(ByVal CheckTextPath As String, ByVal CheckText As String)
    
    Dim check As Boolean:  check = False
    
    If Driver.FindElementByCss(checkTextXPath).Text = CheckText Then check = True

    textCheck = check

End Function

ページが読み込めない場合の処理とかも必要かな。

これだけでもXPath取得するだけでChrome操作色々できるんちゃうかな。
知らんけど（笑）

クラスモジュール使うとけっこう楽しそう。
今度はOutlookの操作もクラスモジュールで作ってみようかな。

というわけで今日はいじょうです。