VBAからURLをPowershellに投げて、ScreenShotを撮るCaputureWebPage

注意点

• 今回は64ビットのパワーシェルを使いますが、32ビットでも動きます。
• パワーシェルのスクリプトを作ります。名前と場所は下記のとおりです
• そのうえでVBAをつくります
• これはアクセスのフォーム用のためMe.F05DirectLink.Valueのところは適宜URLを表す文字型変数にしてください。
• IEのウィンドを最前面化するときは不安定ですので、操作をしないようにしてください。
• ファイルはOneDrive\画像\スクリーンショットに作っていますが適当にかえてください。
• 画像はPNG形式ですが、Ps1のFormat = "png" を "jpeg"に変えて保存する拡張子をJpgにするとjpgで保存できます。容量はjpgの方が小さいです。

VBA

ThrowURLVBA()

Sub ThrowUrlVBA
'iwshRuntimeLibrary に参照設定してください
'ps1ファイルが C:\users\username\ondrive\ドキュメント\MyScript\ps_WebScr.ps1だとします
Dim oWSH As IWshRuntimeLibrary.WshShell: Set oWSH = New WshShell
Dim CMD As String
Dim strps As String
strps = oWSH.ExpandEnvironmentStrings("%USERPROFILE%") & "\OneDrive\ドキュメント\MyScript\ps_fnWebScr.ps1"
CMD = "Cmd /C C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe -nologo -command Set-executionpolicy remotesigned -scope process -f;" & strps & " -strWebUrl """"" & Chr(92) & Chr(34) & Chr(34) & Chr(92) & Chr(34) & """" & Me.F05DirectLink.Value & """""" & Chr(92) & Chr(34) & Chr(34) & Chr(34) & Chr(92) & Chr(34) & Chr(34) & Chr(34)
Debug.Print CMD
oWSH.Run CMD, 0, True
Set oWSH = Nothing
End Sub

Powershell

ps_WebScr.ps1

# Set-ExecutionPolicy RemoteSigned -Scope Process -Force
Param([System.String[]]$strWebUrl)

Function  WebScr([system.string]$strWebUrl){
  process {
 $consUsrfolder=Join-Path $env:USERPROFILE "OneDrive\画像\スクリーンショット"
$strFile= (get-date -UFormat "%Y-%m-%d_%H%M%S") + ".png" #下の$Formatと拡張子を合わせる
$ie = New-Object -ComObject InternetExplorer.Application
$ie.Navigate($strWebUrl)
$ie.visible=$true
# Wait for the page to finish loading
while($ie.Busy) { Start-Sleep -milliseconds 100 }

# IEをアクティブにする
add-type -AssemblyName microsoft.VisualBasic
add-type -AssemblyName System.Windows.Forms
Start-Sleep -Seconds 4
$b = (Get-Process | Where-Object {$_.MainWindowTitle -like "*inte*"}).id
start-sleep -Milliseconds 2000
[Microsoft.VisualBasic.Interaction]::AppActivate($b)

$ie.fullscreen = $true

# Take A ScreenShot (Script taken from Stackflow)
[System.Reflection.Assembly]::LoadWithPartialName("System.Drawing") | Out-Null
# IE のウィンドウを前面に持ってくる
$wsh = new-object -com WScript.Shell
$wsh.AppActivate("Explorer")

$bmp = New-Object Drawing.Bitmap($ie.Width, $ie.Height)
$graphics = [Drawing.Graphics]::FromImage($bmp)
$format = "png" #画像形式決定
$graphics.CopyFromScreen($ie.Left, $ie.Top, 0, 0, $bmp.Size)
$strfullpathname = Join-Path $consUsrfolder $strfile #
$bmp.Save($strfullpathname, $format)

$ie.fullscreen = $false
$ie.Quit()
$graphics.Dispose()
$bmp.Dispose()
}#End of Process

}#End of Function WebScr


<#
Refferenced Url:
https://stackoverflow.com/questions/26535311/powershell-scroll-down-a-webpage-powershell-screenshot
Environ:
https://techracho.bpsinc.jp/baba/2010_03_22/1247
DateStrng
https://cheshire-wara.com/powershell/ps-cmdlets/system-service/get-date/
How to Hidden toolbar
https://social.technet.microsoft.com/Forums/en-US/024dfaee-bcb7-405e-aa1b-d3b890d7fcd1/start-internet-explorer-without-menu-bar-and-tab-bar?forum=winserverpowershell
https://blogs.technet.microsoft.com/heyscriptingguy/2006/12/13/how-can-i-create-a-shortcut-that-opens-internet-explorer-with-the-address-bar-hidden/
Escape Character
https://qiita.com/ww24/items/7d52df13fef5bc54e149
http://d.hatena.ne.jp/yu-hr/20100318/1268851171
#>
WebScr -strWebUrl $args[0]

ポイント

エスケープのバックスラッシュもしくは円マーク

これはVBAからCMDExeに送り、そこからPowershellを起動するのですが、URLを送るのがネックでした。調べてみるとCMD.exeの段階でエスケープしないとダブルクォーテーションが送れず、エスケープ文字が￥マークとのこと（海外だとバックスラッシュ）
この表記の差がでないようにChr(92)でごまかしています。

最後に

長所

一般的にVBAからスクショをとる場合、エクセルを利用する方法がありますが、エクセル自体からならともかく、これは遅いです。しかし返り値もいらないのならPoweshellを使ってもいいと思います。Poweshellの動作は早いためStart-Sleepでわざと6秒をかけているほどです。実際高速です。またVBScriptからも呼び出せます。その場合はオフィスすらいらないことになります。

短所

前記載したとおりWindowの最前面化が不安定なのと、ページを開くタイミングが合わない、または空のページだと
\$b = (Get-Process | Where-Object {$_.MainWindowTitle -like "*inte*"}).id
ここがエラーになります。
またここがエラーになりやすいのでInteという名前があると番号を拾うので、似たものがあると誤爆するかもしれません。なるべくIE以外開かないようにするかinteをinternetくらいに伸ばすとよいと思います。でも不安定なのでやってません。

VBS

VbScriptはPowershellのスクリプトを入れ込み、単独で動くようにしました。あまり窓が開いていると最前列に行くのはうまくいかないです。やっぱり\$bが影響しているのでしょうか。そんなときは手動でALT+TABでウィンドを遷移させて探し、最前列に移動できるようすこし長めにしてあります。
また32Bitで動かしていますが簡単に64Bitに変えられるようConstを設定しました。
画像の保存フォルダはE:\です。\$consUsrfolder='E:\'で決定しているのでここを書き換えてください。
これで動くようならArgumentを使い、URLを引数で入れるようにするとよいと思います。

ThrowURL.vbs

Dim oWSH : Set oWSH = CreateObject("WScript.Shell")
Dim oWSH : Set oWSH = CreateObject("WScript.Shell")
Dim sCMD 'As String
Dim strURL 'As String
Const PS32 = "c:\windows\SysWow64\WindowsPowerShell\V1.0\powershell.exe -nologo -command "
Const PS64 = "c:\windows\System32\WindowsPowerShell\V1.0\powershell.exe -nologo -command "
StrURL = "http://www.google.com"
sCMD = "Cmd.exe /c " & PS32
sCMD = sCmd & """Set-exeCutionpolicy remotesigned -s process -f;$consUsrfolder='E:\';$strFile= (get-date -UFormat '%Y-%m-%d_%H%M%S') + '.png';$ie = New-Object -ComObject InternetExplorer.Application;$ie.Navigate(" & "'" & strURL & "'" & ");$ie.visible=$true;while($ie.Busy){Start-Sleep -milliseconds 100};add-type -AssemblyName microsoft.VisualBasic;add-type -AssemblyName microsoft.VisualBasic;add-type -AssemblyName System.Windows.Forms;Start-Sleep -Seconds 4;$b = (Get-Process | Where-Object {$_.MainWindowTitle -like '*inte*'}).id;$ie.fullscreen = $true;Start-Sleep -s 3;[System.Reflection.Assembly]::LoadWithPartialName('System.Drawing') | Out-Null;$bmp = New-Object Drawing.Bitmap($ie.Width, $ie.Height);$graphics = [Drawing.Graphics]::FromImage($bmp);$format = 'png';$graphics.CopyFromScreen($ie.Left, $ie.Top, 0, 0, $bmp.Size);$strfullpathname = Join-Path $consUsrfolder $strfile;$bmp.Save($strfullpathname, $format);$ie.fullscreen = $false;$ie.Quit();$graphics.Dispose();$bmp.Dispose();"""
WScript.Echo sCMD
oWSH.Run sCMD, 0, True
Set oWSH = Nothing
WScript.Quit