背景
ファイルダウンロード厳禁のセキュリティつよつよ現場で、Seleniumを使わずにブラウザのテンプレート作業を自動化したい。
ステップ0. Windows API一覧
いろいろ使います。ちなみにサイト閲覧も厳禁のため、以下のコードを「覚える」必要があります。
つらいね。
Option Explicit
' ----------------------------------------------------------------------------------------
' タイマー
' ----------------------------------------------------------------------------------------
Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
' ----------------------------------------------------------------------------------------
' マウス
' ----------------------------------------------------------------------------------------
Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Declare Function GetCursorPos Lib "user32" (lpPoint As coord) As Long
Declare Sub mouse_event Lib "user32" (ByVal flags As Long, _
Optional ByVal dx As Long = 0, _
Optional ByVal dy As Long = 0, _
Optional ByVal dwDate As Long = 0, _
Optional ByVal dwExtraInfo As Long = 0)
' ----------------------------------------------------------------------------------------
' キーボード
' ----------------------------------------------------------------------------------------
Declare Function GetAsyncKeyState Lib "user32" (ByVal key_id As Long) As Integer
Declare Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long _
)
' ----------------------------------------------------------------------------------------
' ウィンドウ
' ----------------------------------------------------------------------------------------
Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function MoveWindow Lib "user32" ( _
ByVal hwnd As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
' ----------------------------------------------------------------------------------------
' クリップボード
' ----------------------------------------------------------------------------------------
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
ステップ0. Windows API関連の便利メソッド
Option Explicit
' 2次元座標 (マウス座標用)
Type coord
x As Long
y As Long
End Type
Public Const KEY_KIND_MAX As Long = 255
Public keyInputTime(KEY_KIND_MAX) As Long
' マウスの左クリック
Public Sub MouseLeftClick(x As Long, y As Long)
' クリックで最前面に。
Call SetCursorPos(x, y)
mouse_event (2)
mouse_event (4)
End Sub
' キーの押下時間を初期化する。
Public Sub resetKeyInfo()
Dim i As Long
For i = 0 To KEY_KIND_MAX
keyInputTime(i) = 0
Next
End Sub
' キーの押下時間を保存する。
Public Sub updateKeyInfo()
Dim i As Long
For i = 0 To KEY_KIND_MAX
If (GetAsyncKeyState(i)) Then
keyInputTime(i) = keyInputTime(i) + 1
Else
keyInputTime(i) = 0
End If
Next
End Sub
' クリップボードをクリアする。
Public Sub ClearClipboard()
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
End Sub
ステップ１．まずは画面のリサイズから
Chromeのウィンドウであるかどうかの判定が面倒のため、
Chromeの画面をクリックして最前面に表示してから、ウィンドウハンドルを取得するという手段を取っています。
マウスのクリック座標の再現によって自動化を図るという関係上、画面リサイズは必須なのです。（2回目以降使いまわせなくなるので）
Sub WindowResize()
Const MOUSE_CLICK_X As Long = 200
Const MOUSE_CLICK_Y As Long = 200
Dim w As window
Dim result As Long
Dim hwnd As Long
' クリックで最前面に。
Call MouseLeftClick(MOUSE_CLICK_X, MOUSE_CLICK_Y)
Sleep (100)
hwnd = GetForegroundWindow
With ThisWorkbook.Worksheets("マウス操作")
Dim left, top, width, height As Long
left = .Range("B3").Value
top = .Range("B3").Offset(1, 0).Value
width = .Range("B3").Offset(2, 0).Value
height = .Range("B3").Offset(3, 0).Value
result = MoveWindow(hwnd, left, top, width, height, True)
End With
End Sub使用するAPI関数は、GetForegroundWindowとMoveWindowだけ。簡単ね。
ステップ２．自動化したい作業を記録する。
' -----------------------------------------------------------------
' キー情報を保存する。
' -----------------------------------------------------------------
Public Sub SaveKeyEvent()
Dim lkey As Long
Dim row As Long
Dim c As coord
Dim clickCount As Long
Dim sh As Worksheet
Dim rBaseCommand As Range
Set sh = ThisWorkbook.Worksheets("マウス操作")
Set rBaseCommand = sh.Range("b15")
rBaseCommand.Resize(1000, 3).Value = ""
row = 0
clickCount = 0
Call resetKeyInfo
' どうしてか左クリックが入力した状態で
' マクロが開始する場合があるので、一度ここでリセットする。
GetAsyncKeyState (vbKeyLButton)
' Escキーが押されるまで実行する。
Do While keyInputTime(vbKeyEscape) = 0
DoEvents
Sleep (50) ' 0.05ms待機
Call updateKeyInfo
' マウスクリック
If (keyInputTime(vbKeyLButton) = 1) Then
Call GetCursorPos(c)
rBaseCommand.Offset(row, 0) = "CLICK"
rBaseCommand.Offset(row, 1) = c.x
rBaseCommand.Offset(row, 2) = c.y
clickCount = clickCount + 1
row = row + 1
' ページダウン
ElseIf (keyInputTime(vbKeyPageDown) = 1) Then
rBaseCommand.Offset(row, 0) = "PAGE_DOWN"
clickCount = clickCount + 1
End If
Loop
MsgBox ("記録完了")
End Sub少し余計なコードも混じっているかもですが、ブラウザで自動化する際の動作としては基本的には
「左クリック」「テキスト入力」「スクロール」くらいだと思います。
ここでは「左クリック」「スクロール」の保存を行います。
クリック or ボタンが押されてから1回目の時のみ記録を残します。
この条件を設定しないと、少し押されただけで数十回分ほどクリックされた判定で通ってしまうからです。
また、スクロールはマウスのホイール回転情報の取得が非常に難しいため、PageDownで代用しています。
Escが押されるまで無限ループするため、DoEventsを挟んで画面硬直を回避しています。
ステップ２-5．スクリーンショットを証跡として残す。
マクロが正常に動作したのか、証跡を要求される可能性を考慮して、以下のコードを実行します。
' スクリーンショットを取得する。
Private Sub SavePicture()
Dim x As Long
Dim y As Long
Dim beginTime As Double
Dim count As Long
count = 0
Const KEY_DOWN As Long = 1
Const KEY_UP As Long = 2
Call ClearClipboard
' Application.CutCopyMode = False
With ThisWorkbook.Worksheets("キャプチャ")
Call MouseLeftClick(444, 502)
keybd_event &HA4, 0, KEY_DOWN, 0
keybd_event vbKeySnapshot, 0, KEY_DOWN, 0
keybd_event vbKeySnapshot, 0, KEY_UP, 0
DoEvents
Sleep (10)
DoEvents
keybd_event &HA4, 0, KEY_UP, 0
DoEvents
beginTime = Timer
On Error GoTo TryAgain
.Cells(1, 1).PasteSpecial
DoEvents
Sleep (300)
DoEvents
' トリム
Dim w, h As Double
Dim centerX, centerY As Long
Dim wRatio, hRatio As Double
Dim duplicate As Variant
centerX = 441
centerY = 503
Dim ScreenWidth, ScreenHeight As Double
ScreenWidth = 1280
ScreenHeight = 960
.Cells(1, 1).Select
Dim s As Shape
For Each s In .Shapes
s.LockAspectRatio = msoFalse
h = s.height
w = s.width
wRatio = (centerX / ScreenWidth)
hRatio = (centerY / ScreenHeight)
s.PictureFormat.CropTop = h * (hRatio - 0.1)
s.PictureFormat.CropBottom = h * (1 - hRatio - 0.1)
s.PictureFormat.CropLeft = w * (wRatio - 0.1)
s.PictureFormat.CropRight = w * (1 - wRatio - 0.1)
s.top = ThisWorkbook.Worksheets("キャプチャ2").Cells(3, 3).top
s.left = ThisWorkbook.Worksheets("キャプチャ2").Cells(3, 3).left
s.CopyPicture
ThisWorkbook.Worksheets("キャプチャ2").Paste Range("C3")
s.Delete
Next
Exit Sub
TryAgain:
Debug.Print Err.Number
count = count + 1
Debug.Print ("トライ : " & Str(count))
DoEvents
Sleep (10)
DoEvents
' 5秒待機してダメならあきらめる。
If (count = 500) Then
Exit Sub
End If
Resume
End With
End Sub
ポイントは３つ
・Alt + printscreenのショートカットは「&HA4」「vbKeySnapshot」で
キーを押した、離したはそれぞれ「１」、「２」で表す。
・Sleepと一緒に必ずDoEventsを実行します。これがないと、クリップボードに画面情報が記録されますが、Paste実行時にエラーになります。
また、念のため、一度のPasteで失敗した場合、何度か繰り返す処理を施している。単体で「Resume」と記載することで、
エラーが起こった行をもう一度実行してくれる。
・PictureFormat.CropXXXでトリミングしています。理由は単純で、クリックできたかどうかの確認には、その周囲の情報だけあればよいため。
ただし、エクセルに取り込まれた画像サイズは原寸のそれとは違うらしいため、割合で、切り取る必要がある。例えば、画像のちょうど中央がクリックされたなら、
(0.4 * w , 0.4 * h) ~ (0.6 * w, 0.6 * h) とすれば、クリック箇所の周囲10%が残る。
ステップ3．記録された作業を再現する。
' -----------------------------------------------------------------
' キー情報をリプレイする。
' -----------------------------------------------------------------
Private Sub replayKeyEvent()
Dim sh As Worksheet
Dim row As Long
Dim i As Long
Set sh = ThisWorkbook.Worksheets("マウス操作")
Dim clickCount As Long
Dim param As String
Dim endRow As Long
Dim count As Long
endRow = sh.Cells(Rows.count, 2).End(xlUp).row
count = endRow - sh.Range(BASE_POS_COMMAND).row
Dim rBaseCommand As Range
Set rBaseCommand = sh.Range(BASE_POS_COMMAND)
For i = 0 To count
row = 2
clickCount = 0
' 1回当たりの動作
Do While (sh.Cells(row, 1) <> "")
Dim key As String
key = sh.Cells(row, 1)
' クリック
If (key = "CLICK") Then
Call SetCursorPos(sh.Cells(row, 2), sh.Cells(row, 3))
Call mouse_event(2)
Call mouse_event(4)
SendKeys "^a"
param = sh.Cells(i + 1, 6 + clickCount)
SendKeys param
clickCount = clickCount + 1
ElseIf (key = "PAGE_DOWN") Then
SendKeys "^{end}"
End If
Call Sleep(100)
row = row + 1
Loop
Next
End Sub書きかけのため、非常にふんわりしていますが、やらんとすることは伝わると思います。
作業記録を上から一行ずつ実行し、終端に達したら終了です。
また、テキスト入力については、〇回目のクリックがされた後で、エクセルから入力値を取得し、SendKeysで送るという形をとっています。