エラー時や証跡残しの際にスクリーンショットを自動で取得したいという事がありましたので
簡単に取得できる方法を作成してみました。

前提：
Windows10の機能を利用しています。
スクリーンショットフォルダにファイルが無い状態で実行することを想定しています。

Windows10では[Windowsキー + Prtscキー]にてスクリーンショットを取得できます。
この機能で取得したスクリーンショットは、
ピクチャ￥スクリーンショット
配下に格納されるのですが、そのファイルのファイル名を変更し、
指定のフォルダに移動させる流れとなっています。

1. エミュレーションにて[Windowsキー + Prtscキー]を実行
   VBscriptでは、WindowsキーやPrtscキーの扱いが難しいのでエミュレーションを使用しています。

2. スクリプトにて「ピクチャ￥スクリーンショット」配下のファイルを移動
   移動先のフォルダとファイル名を指定できます。
   指定したファイル名が存在する場合は、ファイルに引番をつけて格納します。
   例：
   d:\SS.png　が存在する場合は、
   d:\SS_1.png　と言うファイル名とする。

   スクリーンショット取得時に若干の時間がかかる為、スクリプト内で
   ファイルが確認できるまでループする処理を入れています。
   気になる方は、ループする回数を指定し、ループから抜ける処理を追加する等
   記述すると良いでしょう。

スクリプトは以下
--------------------------------------------------------------------

'シェルアプリケーションオブジェクトを作成
Set objApl = CreateObject("Shell.Application")
Set objFile = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
HFolder = !保存フォルダ名!

'ユーザのスクリーンショットフォルダを指定
folderPath = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Pictures\Screenshots"
Set objFolder = objApl.NameSpace(folderPath)

'フォルダオブジェクトから、入っているファイルやフォルダの全情報を取得
Do
Set objFolderItems = objFolder.Items()
If objFolderItems.Count >0 then Exit Do
Loop

For Each objItem In objFolderItems
'取り出した物がファイルかフォルダかを判定
If objItem.IsFolder <> True Then
Folpath = HFolder & "\"

Const BaseFname = !ファイル名!
fpath = Folpath & BaseFname & ".png"

If objFile.FileExists(fpath) Then
Do
cnt = cnt + 1
new_fpath = Folpath & BaseFname & "_" & CStr(cnt) & ".png"
If objFile.FileExists(new_fpath) = False Then

objFile.MoveFile objItem.path, new_fpath
Exit Do
End If
Loop
Else
objFile.MoveFile objItem.path, fpath
End If

exit for
End If
Next

Set objApl = Nothing
Set objFile = Nothing
Set objShell = Nothing
Set objFolder = Nothing
Set objFolderItems = Nothing

--------------------------------------------------------------------

参考まで。