その他

VBAでハンドル情報(Handle等)を用いて他のアプリケーション(ソフトウェア)を操作する。[No20]

投稿日:2020年4月16日 更新日:

スポンサーリンク

VBAでIE(Internet Explorer)の操作ができるようになって、次は他のアプリケーションを操作する方法。自分用のメモとして残しておきます。定期的な確認作業をオートメーションするヒントになれば幸い。

  1. ログイン画面のあるアプリケーションを起動。
  2. ログインを行う。
  3. ログイン後の画面をスクリーンショットで、Excelのシートに貼り付け。
  4. そのシートをPDF出力
  5. そのシートを別のエクセル出力
  6. (今回は紹介しないがメール送信を行えたら良い)

近内はログイン画面のあるアプリケーション(ソフトウェア)としてFFFTPを作業の対象にした。

作成手順

手順1

次の記事でツールを作成しそのツールを用いて手順を進める。

no image
VBAのユーザーフォームでWindow情報を取得する[No19]
動機 自宅にて自動化プログラムを作成することになった。他のアプリケーションの操作にはウィンドウハンドル(Handle)を用いることが多く、コードを書く前にあらかじめ知っておく必要があ ...

手順2

FFFTPをダウンロードして「"C:\ffftp\FFFTP.exe"」になるように保存しておく。

「FFFTP」定番FTPクライアントソフト - 窓の杜
「FFFTP」定番FTPクライアントソフト - 窓の杜

FFFTPのダウンロードはこちら  左右分割型で日本語UIのFTPクライアント。ウィンドウ内左右にローカルディスク側とホスト側のファイル一覧を表示し、ドラッグ&ドロップや右クリックメニューなどの操作で ...

続きを見る

窓の杜はウイルスチェック体制がしっかりしているという情報あり。

窓の杜 - 窓の杜でのウイルスチェックについて
窓の杜 - 窓の杜でのウイルスチェックについて

続きを見る

スポンサーリンク

手順3

Excel(拡張子xlsm)を新規作成。モジュール(Module1)を作成し次のコードで上書きする。


Option Explicit

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
    (ByVal hWndParent As Long, ByVal hwndChildAfter As Long, _
     ByVal lpszClass As String, ByVal lpszWindow As String) As Long

Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
                (ByVal hWnd As Long, _
                 ByVal Msg As Long, _
                 ByVal wParam As Long, _
                 ByVal lParam As String) As Long

Private Declare Sub keybd_event Lib "USER32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Public Sub Main()

    '①区切り線#############################################################################
    '画面0:FFTP起動
    On Error GoTo ErrEnd
        Dim ret As Long
        ret = Shell("C:\ffftp\FFFTP.exe", vbNormalFocus)
    On Error GoTo 0
    
    DoEvents
    Application.Wait Now() + TimeValue("00:00:03")
    DoEvents


    '②区切り線#############################################################################
    Dim className As String
    Dim windowTitleName As String
    '画面1:FFTP起動画面
    className = "#32770"
    windowTitleName = "FFFTP"
    Dim handleOwner As Long
    handleOwner = FindWindow(className, windowTitleName)
    Dim handlechild As Long
    handlechild = FindWindowEx(handleOwner, 0, "Edit", vbNullString)
    Call SendMessage(handlechild, &HC, 0, "Password")
    Dim handleButton As Long
    handleButton = FindWindowEx(handleOwner, 0, "Button", "OK")
    Call SendMessage(handleButton, &H6, 1, 0&)  'ボタン→アクティブ化
    Call SendMessage(handleButton, &HF5, 0, 0&) 'ボタン→クリック

    DoEvents
    Application.Wait Now() + TimeValue("00:00:03")
    DoEvents
    
    
    '③区切り線#############################################################################
    '画面2:ホスト一覧画面
    className = "#32770"
    windowTitleName = "ホスト一覧"
    handleOwner = FindWindow(className, windowTitleName)
    AppActivate windowTitleName
    
    handleButton = FindWindowEx(handleOwner, 0, "Button", "閉じる(&O)")
    Call SendMessage(handleButton, &H6, 1, 0&)  'ボタン→アクティブ化
    Call SendMessage(handleButton, &HF5, 0, 0&) 'ボタン→クリック   
    DoEvents
    Application.Wait Now() + TimeValue("00:00:03")
    DoEvents
    
    
    '④区切り線#############################################################################
    '画面3:FFTP(*)画面
    className = "FFFTPWin"
    windowTitleName = "FFFTP (*)"
    handleOwner = FindWindow(className, windowTitleName)
    AppActivate windowTitleName
    
    
    '⑤区切り線#############################################################################
    'アクティブ画面スクリーンショット
    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&
    
    '全画面スクリーンショット
    'keybd_event vbKeySnapshot, 0&, &H1, 0&
    'keybd_event vbKeySnapshot, 0&, &H1 Or &H2, 0&    DoEvents
    Application.Wait Now() + TimeValue("00:00:01")
    DoEvents
    
    
    '⑥区切り線#############################################################################
    'Sheet1に貼り付け
    Dim sheetName As String
    sheetName = "Sheet1"
    Worksheets(sheetName).Activate
    Range("A1").Select
    ActiveSheet.Paste    'または、SendKeys "+(^V)", True

    DoEvents
    Application.Wait Now() + TimeValue("00:00:01")
    DoEvents

    Range("A25").Select
    ActiveSheet.Paste    'または、SendKeys "+(^V)", True
    
    
    '⑦区切り線#############################################################################
    '出力
    Dim fileName As String
    fileName = "資料(" & Format(Now(), "YYYY年MM月DD日") & "(" & Format(Now(), "aaa") & ")" & "_" & Format(Now(), "hh時nn分ss秒出力") & ")"
    
    'PDF出力
    With ActiveSheet.PageSetup
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=ThisWorkbook.Path & "\" & fileName & ".pdf"
    
    
    '⑧区切り線#############################################################################
    'Excel出力
    Application.DisplayAlerts = False
    Sheets(sheetName).Copy
    ActiveWorkbook.SaveAs _
    fileName:=ThisWorkbook.Path & "\" & fileName, _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    ActiveSheet.DrawingObjects.Delete
    ThisWorkbook.Close
    Application.DisplayAlerts = True
    
    
    '⑨区切り線#############################################################################
    Exit Sub
ErrEnd:
    MsgBox "実行できませんでした。" & vbCrLf & "エラー内容:" & Err.Description
    
End Sub

手順4

筆者のPCではMainを実行すると期待していた動作を得られた。

雑記(2020年4月15日)

明日も良いことがありますように。

関連記事

no image
ウィンドウハンドル関連の記事一覧[No74]
記事一覧 ハンドル番号、キャプション名、クラス名について書かれた記事のまとめです。 最後までお付き合いいただきありがとうございます! この情報が誰かの役にたてれば幸 ...

最後までお付き合いいただきありがとうございます!

この情報が誰かの役にたてれば幸いです。

スポンサーリンク

タグ

-その他

© 2021 BookALittle