【悪用厳禁】VBAでスクショ＆クリックを繰り返す【ゆっくり解説】

ExcelVBAでスクショ＆クリックを繰り返すしてみた
この動画のマクロはWindows11/Office2016で作成してます。

yahooのページでテスト

Sub Macro1()
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'Chromeを起動
    Set driver = CreateObject("Selenium.WebDriver")

    driver.AddArgument "--disable-blink-features=AutomationControlled"  'Seleniumの痕跡を隠す
    driver.Start "chrome"
    '4Kディスプレイにブラウザを表示
    driver.Window.SetSize 1074 * 1.2, 1524 * 1.2
    driver.Window.SetPosition 3840, 0
    
    
    ao_Url = "https://www.yahoo.co.jp/"
    driver.Get ao_Url
    
    
    'ブラウザのスクリーンショットを撮る
    Screenshot_fileName = fso.BuildPath(ThisWorkbook.Path, "test1.png")
    driver.TakeScreenshot.SaveAs Screenshot_fileName
    
    'ヘッダー部分のスクリーンショットを撮る
    Screenshot_fileName = fso.BuildPath(ThisWorkbook.Path, "test2.png")
    Set o_elem1 = driver.FindElementsByCss("#Masthead")
    o_elem1(1).TakeScreenshot.SaveAs Screenshot_fileName

    
    
    Set o_elem1 = driver.FindElementsByCss("body")
    'o_elem1.Item(1).ClickByOffset 200, 233
    driver.Actions.MoveByOffset(200, 233).Click.Perform


    MsgBox "エンドしますよ", , "ボタンを押して進めてください"


    'ブラウザを閉じる
    driver.Quit
    Set driver = Nothing
 
End Sub

青空文庫のページでテスト

#If Win64 Then
    ' Excel が64ビット版の場合の関数定義です。
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    ' Excel が32ビット版の場合の関数定義です。
    Declare  Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Sub Macro()
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'ダウンロード先のフォルダーを消して作成
    download_dir = fso.BuildPath(ThisWorkbook.Path, "screenshot")
    If (fso.FolderExists(download_dir) = True) Then
        '// フォルダが存在する
        fso.DeleteFolder download_dir, True
    End If
    MkDir download_dir
    
    'Chromeを起動
    Set driver = CreateObject("Selenium.WebDriver")

    driver.AddArgument "user-data-dir=" & fso.BuildPath(ThisWorkbook.Path, "edge_vba") 'Cookieを使う
    driver.AddArgument "--disable-blink-features=AutomationControlled"  'Seleniumの痕跡を隠す
    driver.Start "chrome"
    
    '4Kディスプレイに適当な大きさのブラウザを表示
    driver.Window.SetSize 1074 * 1.2, 1524 * 1.2
    driver.Window.SetPosition 3840, 0
    
    '定数
    max_page = 300   'ページ処理の最大数
    f_next_key = 0 'ページ送りの方向    0:左　1:右
    
    'ao_Url = "https://aozora.binb.jp/reader/main.html?cid=623"
    ao_Url = "https://aozora.binb.jp/reader/main.html?cid=50420"
    driver.Get ao_Url
  
    'MsgBoxでスクショを始めたいところまで待つ
    MsgBox "スタートしますよ"
    Call Sleep(3000)  '3秒待つ
    
    '次のタブに制御を移す
    Set o_elem = driver.FindElementsByCss("#contents>iframe")
    driver.SwitchToFrame o_elem.Item(1)
    
    'bodyエレメントの大きさからクリックすべき位置を算出
    Set o_elem = driver.FindElementsByCss("body")
    Set body_size = o_elem.Item(1).Size
    click_x = Int(body_size.Width * (0.5 + (f_next_key - 0.5) / 2))
    click_y = Int(body_size.Height / 2)

    'スクショ&クリックを繰り返す
    f_end = 0
    For i = 0 To max_page
        'ブラウザのスクリーンショットを撮る
        Screenshot_fileName = fso.BuildPath(download_dir, "screenshot" & Right("00000" & i, 4) & ".png")
        driver.TakeScreenshot.SaveAs Screenshot_fileName
        
        If f_end = 0 Then
            'ページを送る
            Set o_elem = driver.FindElementsByCss("body")
            o_elem.Item(1).ClickByOffset click_x, click_y
    
            '次のページが表示されるまで待つ
            Call Sleep(2000)  '2秒待つ

            'bodyのcursorの定義を更新させるためにマウスを動かす
            driver.Actions.MoveByOffset(1, 1).Perform
            Debug.Print i, o_elem.Item(1).CssValue("cursor")
            If o_elem.Item(1).CssValue("cursor") = "default" Then
                f_end = 1    '最後のページ
            End If
        Else
            Exit For
        End If
        DoEvents
    Next

    'ブラウザを閉じる
    driver.Quit
    Set driver = Nothing
 
End Sub