任意のフォルダのスクリーンショットを取得しクリップボードの画像をPNGで保存する（VBA、Powershell）[No94]

任意のフォルダ（ダウンロードフォルダやデスクトップフォルダなど）を画像にして特定フォルダに保存するプログラムを用意しました。今回はそのプログラムを紹介します。

プログラムファイル

処理内容

このプログラムでは、次の構成で実行する必要があります。それぞれを起動すると起こることも併せて記載します。

　・Excelマクロ：フォルダをアクティブにして、スクリーンショットを取得する（＝画像はclipboardに保存されます）。

　　なお、フォルダをアクティブにする際、フォルダが起動していない場合は起動しアクティブ、フォルダが起動している場合は何もせずアクティブにする。

　・ps1ファイル：clipboardに保存された画像をファイルにして保存する。

実行は「Excelマクロ」、「ps1ファイル」の順で行っていきます。

構成

Excelマクロとして、デスクトップに「任意フォルダのスクリーンショットを取得.xlsm」を配置する。


'Declare PtrSafe Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'Declare PtrSafe Sub keybd_event Lib "user32" Alias "keybd_event" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
Declare PtrSafe Sub keybd_event Lib "user32" ( _
    ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)

'Declare PtrSafe Function BringWindowToTop Lib "user32" Alias "BringWindowToTop" (ByVal hwnd As LongPtr) As Long
Declare PtrSafe Function BringWindowToTop Lib "user32" (ByVal hwnd As LongPtr) As Long

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As LongPtr
    
Public Sub Main()
    
    'フォルダパスを設定する※環境変数の名前を含む文字列を利用
    'ユーザープロファイル：Environ("USERPROFILE")
    Dim folderPath As String
    folderPath = Environ("USERPROFILE") & "\Downloads"
    
    Dim targetAppTitle As String
    targetAppTitle = "ダウンロード"
    
    Dim psFilePath As String
    psFilePath = "D:\Application\DNo00002\OutoutClipboard.ps1"
    
    Dim appFilePath As String
    appFilePath = "C:\Windows\Explorer.exe"
    
    If Dir(folderPath, vbDirectory) <> "" Then
    
        Dim hwnd As Long
        hwnd = FindWindow(vbNullString, targetAppTitle)
        
        If hwnd = 0 Then
            Shell appFilePath & " " & folderPath, vbNormalFocus
        Else
            BringWindowToTop hwnd
        End If
        
        timeWait ("00:00:03")
        
        'アクティブ画面スクリーンショット（Alt + PrintScreen）
        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&
        
        timeWait ("00:00:03")
        
        Dim objWsh
        Set objWsh = CreateObject("WScript.Shell")
        
        Dim execCommand As String
        execCommand = "powershell -NoProfile -NoLogo -ExecutionPolicy Unrestricted " & psFilePath
        
        Dim result As Long
        result = objWsh.Run(Command:=execCommand, WindowStyle:=0, WaitOnReturn:=True)
        
        If (result = 0) Then
            Debug.Print ("Windows PowerShell 正常終了")
        Else
            Debug.Print ("Windows PowerShell 異常終了")
        End If

    Else
        Debug.Print folderPath & "が存在しません。ご確認ください。"
        GoTo ReleaseObject
    End If
    
ReleaseObject:
    Set objWsh = Nothing
End Sub

Public Sub timeWait(ByVal myTime As String)
    Dim waitTime As Date
    waitTime = Now + TimeValue(myTime)

    DoEvents
        Application.Wait waitTime
    DoEvents
End Sub

ps1ファイルとして、「D:\Application\DNo00002」に「OutoutClipboard.ps1」を用意する。

また、同階層の「D:\Application\DNo00002」に「output」フォルダを用意する。


#$wsobj = new-object -comobject wscript.shell
#$result = $wsobj.popup("Hello World")

#アセンブリ読み込み
Add-Type -AssemblyName System.Drawing
Add-Type -AssemblyName System.Windows.Forms

$outputFolderPath01 = "D:\Application\DNo00002\output"
$nowDate = (Get-Date).ToString("yyyyMMdd_HHmm") 
$identificationName = "test"
$outputFolderPath02 = $nowDate + "_" + $identificationName

$outputFolderPath = ($outputFolderPath01 + "\" + $outputFolderPath02)

New-Item ($outputFolderPath) -ItemType Directory -Force

#各種設定
#■□■□
#何ミリ秒ごとに取得するか
$sleepTime = 250
#■□■□

#ミリ秒数停止
Start-Sleep -Milliseconds $sleepTime

#日時取得、座標編集
$nowTime = (Get-Date)
$nowTimeFileName = $nowTime.ToString("yyyyMMdd_HHmmss") 

#ファイル名編集
$outputFileName  = ($identificationName + "_" + $nowTimeFileName + ".png")

#クリップボードに画像があれば保存
$clipboardImage = [Windows.Forms.Clipboard]::GetImage()
if ($clipboardImage -ne $null)
{
	$outputFilePath =($outputFolderPath + "\" + $outputFileName)
	$clipboardImage.Save($outputFilePath)
}