RPAもどき

VBAを使ってIEの入力補助を行うコード
```
Private Declare PtrSafe Sub keybd_event Lib "user32" ( _
    ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long _
        )
        
'Win32 APIのSetForegroundWindowを使用する
' Excel 64bit用
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" ( _
    ByVal hwnd As LongPtr) As Long


Const 入力開始行 As Long = 4
Const Form属性列 As Long = 1
Const FormID列 As Long = 2
Const FormName列 As Long = 3
Const Form値 As Long = 4

Dim Form入力行 As Long

Dim bodyHeight As Long
Dim windowHeight As Long
Dim bottomPoint As Long
Dim currentPos As Long
Dim pastePos As Long

Sub 自動入力()
 
' Application.ScreenUpdating = False ' Excelの画面の変化を表示をしないことで高速に実行できる

 '起動済みのIEを取得する
    Dim shl As Object 'シェルオブジェクト生成
    Set shl = CreateObject("Shell.Application")
    
    With Worksheets("入力")
    
        Dim targetTitle As String '取得したいウィンドウのタイトルを設定
        targetTitle = .Cells(1, 3).Value 'C1固定
            
        Dim win As Object, getFlag As Boolean
        For Each win In shl.Windows '起動中のウィンドウを順番にみていく
            
            'IEとエクスプローラがシェルで取得されるため、IEのみ処理
            If TypeName(win.document) = "HTMLDocument" Then
                If win.document.Title = targetTitle Then
        
                    Dim objIE As New InternetExplorer
                    Set objIE = win
                    
                    getFlag = True '正しく取得できた
                    Exit For
                End If
            End If
            
        Next
        
        If getFlag = False Then
            MsgBox "目的の画面が開かれていません。", vbExclamation
            Exit Sub
        End If
        
        Form入力行 = 入力開始行
        
        Do While .Cells(Form入力行, 1).Value = "入力" Or .Cells(Form入力行, 1).Value = "クリック"
        
            If .Cells(Form入力行, 1).Value = "入力" Then
        
                If .Cells(Form入力行, FormID列).Value <> "" Then
                 objIE.document.getElementById(.Cells(Form入力行, FormID列).Value).Value = .Cells(Form入力行, Form値).Value
                
                ElseIf .Cells(Form入力行, FormName列).Value <> "" Then
                    objIE.document.getElementsByName(.Cells(Form入力行, FormName列).Value)(0).Value = .Cells(Form入力行, Form値).Value
                End If
                
            End If
            
            If .Cells(Form入力行, 1).Value = "クリック" Then
            
                If .Cells(Form入力行, FormID列).Value <> "" Then
                    objIE.document.getElementById(.Cells(Form入力行, FormID列).Value).Click
                ElseIf .Cells(Form入力行, FormName列).Value <> "" Then
                    objIE.document.getElementsByName(.Cells(Form入力行, FormName列).Value)(0).Click
                End If
            
            End If
            
            Form入力行 = Form入力行 + 1
        
        Loop
        
        ' ボタンクリック 一つの想定
        Do While .Cells(Form入力行, 1).Value = "送信"
            If .Cells(Form入力行, FormID列).Value <> "" Then
                objIE.document.getElementById(.Cells(Form入力行, FormID列).Value).Click
            
            ElseIf .Cells(Form入力行, FormName列).Value <> "" Then
                objIE.document.getElementsByName(.Cells(Form入力行, FormName列).Value)(0).Click
            End If
            Form入力行 = Form入力行 + 1
        Loop
    
    End With
    
    ' 表示されるまで待機
    Call IEWait(objIE)
    
    'IEを最前面に表示
    Sleep (500)
    
    SetForegroundWindow (objIE.hwnd)
        
    
    bodyHeight = objIE.document.body.clientHeight ' bodyの高さを取得
    windowHeight = objIE.document.DocumentElement.clientHeight 'windowの高さを取得
    bottomPoint = bodyHeight - windowHeight ' ページ最下部までスクロールしたかを判定するための位置を計算
    
    ' スクリーンショット
    Sleep (1000)
    Call アクティブ画面を撮る
    pastePos = 1
    Sleep (1000)
    Worksheets("エビデンス").Cells(pastePos, 1).PasteSpecial
    
    'currentPos = objIE.Window.pageYOffset ' スクロール量を取得
    currentPos = 0
        
    ' スクロールが最下部になるまで
    Do While bottomPoint > currentPos
    
        Sleep (1000)
        objIE.navigate "JavaScript:" & "scrollBy(0, " & windowHeight & ")"
        Sleep (2000)
        Call アクティブ画面を撮る
        Sleep (1000)
        pastePos = pastePos + windowHeight / 15
        Worksheets("エビデンス").Cells(pastePos, 1).PasteSpecial
        'currentPos = objIE.Window.pageYOffset ' スクロール量を取得
        currentPos = currentPos + windowHeight
        Sleep (2000)
    
    Loop
        
    Application.ScreenUpdating = True ' Excelの表示を元に戻す
    
    MsgBox "完了"
    
End Sub

'---IEを待機する関数---
Function IEWait(ByRef objIE As Object)
    Const READYSTATE_COMPLETE = 4
    Do While objIE.Busy = True Or objIE.readyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
End Function

Public Sub アクティブ画面を撮る()
    keybd_event &HA4, 0&, &H1, 0&
    keybd_event vbKeySnapshot, 0&, &H1, 0&
    keybd_event vbKeySnapshot, 0&, &H1 Or &H2, 0&
    keybd_event &HA4, 0&, &H1 Or &H2, 0&
End Sub

```