歴史的発見
VBAからPowershellを使ってExif撮影日付を取得(コンソール画面非表示) VBA Exif phototeken date
今回はこのコンソール画面非表示という発見を以前の記事のファイルを書き換えてみたいと思います。
[EXCEL2013以降64BIT版で簡単URLエンコード EXCEL2013 Later URLEncode Function](EXCEL2013以降64BIT版で簡単URLエンコード EXCEL2013 Later URLEncode Function)
仕様
Windows Xp 以外 Win2k以降に追加された Clip.exe
とPowershellのClipを使います。
というのもDecodeの時は文字化けしてしまうからです。
Microsoft Forms 2.0 object library を参照設定してください。
またExcelは64bitでも32bitでもかまいません。
Powershellのバージョンは関係ないのかな。これはよくわかりません。
64bitでは下記のVBAは動かない
Public Function URL_Decode(ByVal strOrg As String) As String
'http://www.relief.jp/itnote/archives/003799.php
With CreateObject("ScriptControl")
.Language = "JScript"
URL_Decode = .CodeObject.decodeURI(strOrg)
End With
End Function
reliefさんのこのコードはうごきません。なぜならJscriptが動かないからです。
そのかわりexcel 2013以降は Encodeurlというワークシートファンクションがあるので、エンコードはできます。
ENCODEURL関数
For EXCEL OR ACCESS (reference setting EXCEL XX.X Object Library)
EXCEL、EXCELを参照設定したアクセスで使える関数です
Function fnURLENCODE2013(str as String)
Dim xlApp As New Excel.Application
fnURLENCODE2013 = xlApp.WorksheetFunction.EncodeURL(str)
End Function
PowerShellを使ってutf-8エンコード、デコードを行う
今回はパワーシェルでURLをエンコード、デコードして、クリップボードから値を戻します。
Sub EncodeDecodeTest()
Const strG = "https://www.google.co.jp/search?newwindow=1&site=&source=hp&btnG=%E6%A4%9C%E7%B4%A2&q="
Dim buf As String: buf = EncodeURLPS("たくあん和尚", "utf-8")
Dim RETvalue
With New MSForms.DataObject
.Clear
DEcodeURLPS (strG & buf)
.GetFromClipboard
Debug.Print .GetText
End With
End Sub
Private Function DEcodeURLPS(ByVal TargetString)
Dim cmd
TargetString = Replace(TargetString, "`", "``")
TargetString = Replace(TargetString, """", "`""""""")
cmd = "Powershell -command ""Set-executionpolicy remotesigned -scope process -force;[void] [Reflection.Assembly]::LoadWithPartialName(""""""System.Windows.Forms"""""");Add-Type -AssemblyName System.Windows.Forms;[System.Windows.Forms.Clipboard]::Clear();Add-Type -AssemblyName System.Web;"
cmd = cmd & "$string=" & "'" & TargetString & "'"
cmd = cmd & ";$decodeURL = [System.Web.HttpUtility]::UrlDecode($String);set-clipboard $decodeURL; Return $decodeURL;" & """"
cmd = Replace(cmd, vbCrLf, "", 1, -1)
'DEcodeURLPS = CreateObject("WScript.Shell").Exec(cmd).StdOut.ReadAll
CreateObject("WScript.Shell").Run cmd, 0, True
End Function
Private Function EncodeURLPS(ByVal TargetString, ByVal CodeName)
Dim cmd
TargetString = Replace(TargetString, "`", "``")
TargetString = Replace(TargetString, """", "`""""""")
cmd = "PowerShell -Command "" set-executionpolicy remotesigned -scope process -force;[void]([Reflection.Assembly]::LoadWithPartialName(""""""System.Web""""""));[Web.HttpUtility]::UrlEncode(""""""" & TargetString & """"""", [Text.Encoding]::GetEncoding(""""""" & CodeName & """""""))""|Clip"
CreateObject("WScript.Shell").Run cmd, 0, True
On Error Resume Next
With New MSForms.DataObject
.GetFromClipboard
RET = CStr(.GetText)
EncodeURLPS = RET
End With
On Error GoTo 0
If Err.Number <> 0 Then Debug.Print Err.Description: Err
Set FSO = Nothing: Set oWSH = Nothing
End Function
EncodeDecodeTest()を起動させるとイミディエイトウィンドウに
https://www.google.co.jp/search?newwindow=1&site=&source=hp&btnG=検索&q=たくあん和尚
と表示されれば成功です。
2つのクリップ 2 type Clips
これは間違っているかもしれないのですが
1.Encodeの時はWindowsのClip
2.Decodeの時はパワーシェルのクリップ
を使い分けています。
というのもDecodeの時は文字化けしてしまうからです。
長所
見た目がとっつきにくいのですが、なんといてもパワーシェルのスクリプトを内包し、かつコンソールウィンドウが開かないというのが売りです。
またクリップボードに値を受け渡すとき、文字化けする場合は、パワーシェルのスクリプトの中でクリップボードに値を書きこみ、あとから取り出せば文字化けが防げることがわかりました。
革新性 innovativeness
以上から非常に重要なことはコンソールウィンドウが開かなくなったことで、VBAはパワーシェルを使役することができるようになったということです。つまりVBAでできなくてもパワーシェルでできるのなら、そちらで処理をして値や関数を受け渡せます。
もっともVBSの場合、クリップボードはIEを使用する必要がありますが。
またWscript.Runで起動しているので、処理が同期するようになった点もポイントです。
Run メソッド