EXCEL2013以降64BIT版で簡単URLエンコード EXCEL2013 Later URLEncode Function

##Scriptcontrolが64bitは使えない
[64ビット環境でのScriptControlの代わり](http://www.ka-net.org/office/of32.html)
まあそんな感じで悩んでいたのですが、 ~~なんだあるじゃないか。~~ EXCEL2010 64bit版までの悩みだったようです。EXCEL2010 64bitをお使いの場合はPowershell版を使うなどの必要がありましたが、Excel 2013 以降では解消されています。これでユーザーファンクションを組むとURLエンコードが可能になります。
アクセスでも使えるようにCreateobjectしたものとvbscriptも作っておきました。

###VBA

####For ACCESS

```VB:VBA"fnURLENCODE2013"
Function fnURLENCODE2013(str as String)
' For Access
' No Reference Setting
Dim xlApp: Set xlApp = CreateObject("Excel.application")
fnURLENCODE2013 = xlApp.WorksheetFunction.EncodeURL(str)
Set xlApp = Nothing
End Function
```

####For EXCEL OR ACCESS (reference setting EXCEL XX.X Object Library)
EXCEL、EXCELを参照設定したアクセスで使える関数です

```VB:VBA"fnURLENCODE2013"
Function fnURLENCODE2013(str as String)
' For Access
' 参照設定が必要 Need Reference Setting "Microsoft Excel Application"
Dim xlApp As New Excel.Application
fnURLENCODE2013 = xlApp.WorksheetFunction.EncodeURL(str)
End Function
```

###VBS
EXCEL2013以降がインストールされている場合、こちらを使うことができます。


```VB:VBS"fnURLENCODE2013
Function fnURLENCODE2013(str)
' For VBScript
' Excel 2013 Later Isntalled PC
Dim xlApp: Set xlApp = CreateObject("Excel.application")
fnURLENCODE2013 = xlApp.WorksheetFunction.EncodeURL(str)
Set xlApp = Nothing
End Function
```

##注意
もちろんこれはEXCEL 2013 がないとだめです。
[ENCODEURL関数](https://support.office.com/ja-jp/article/ENCODEURL-%E9%96%A2%E6%95%B0-07c7fb90-7c60-4bff-8687-fac50fe33d0e)

##謎
ところで、EXCEL2016 64bit +Win 10で上記解説の
=WEBSERVICE("http://xml.weather.yahoo.com/forecastrss/"&ENCODEURL(B2)&"_f.xml")
って動いた方います？
当方ではWEBService関数がこのxmlなんとかでは動かないみたいです。

##地味な使い方
Note: This is google Japan
とりあえずEXCELを起動して
A1
https://www.google.co.jp/search?newwindow=1&site=&source=hp&btnG=%E6%A4%9C%E7%B4%A2&q=
B1
=ENCODEURL("たくあん和尚")
C1
=Hyperlink(A1&B1)
とするとC1に検索URLができます

##地味な使い方その2
###VBA

```VB:VBA"MakeGoogleSerchString"
Sub MakeGoogleSerchString()
Dim objIe: Set objIe = CreateObject("InternetExplorer.Application"): objIe.Visible = True
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 = fnURLENCODE2013("たくわん和尚")
Debug.Print strG & buf
objIe.navigate strG & buf
  Do While objIe.Busy = True Or objIe.readyState <> 4
    DoEvents
  Loop
End Sub
Function fnURLENCODE2013(str as String)
Dim xlApp: Set xlApp = CreateObject("Excel.application")
fnURLENCODE2013 = xlApp.WorksheetFunction.EncodeURL(str)
Set xlApp = Nothing
End Function
```
###VBS
最後URLが表示されてOKを押すとIEが完全に表示されます。

```VB:VBScript"MakeGoogleSerchString.VBS"
Dim objIe: Set objIe = CreateObject("InternetExplorer.Application"): objIe.Visible = True
Const strG = "https://www.google.co.jp/search?newwindow=1&site=&source=hp&btnG=%E6%A4%9C%E7%B4%A2&q="
Dim buf : buf = fnURLENCODE2013("たくあん和尚")
WScript.Echo strG & buf
objIe.navigate strG & buf
WScript.Echo strG & buf
WScript.Quit

Function fnURLENCODE2013(str)
Dim xlApp: Set xlApp = CreateObject("Excel.application")
fnURLENCODE2013 = xlApp.WorksheetFunction.EncodeURL(str)
Set xlApp = Nothing
End Function

```

##PowerShell版も改造したので
参考: http://blog.powershell-from.jp/?p=222
~~Set-ExecutionPolicy を入れてみました。これだと一般的に動くでしょう。~~
ps1ファイルのスクリプトを動かすときは必要ですが、コマンドラインはそのままで動くんですね。パワーシェルをみたらsexpr spfを入れる脊髄反射は正しくないようです。(Set-ExecutionPolicy Remotesigned -Scope Process -Forceの私的略語)
ただししばらく青い窓が開きます。がsexprを入れているより早く閉まるようになりました。

```VB:VBA"MakeGoogleSerchString"
Sub MakeGoogleSerchString2()
Dim objIe: Set objIe = CreateObject("InternetExplorer.Application"): objIe.Visible = True
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")
Debug.Print strG & buf
objIe.navigate strG & buf
  Do While objIe.Busy = True Or objIe.readyState <> 4
    DoEvents
  Loop
End Sub

Private Function EncodeURLPS(ByVal TargetString, ByVal CodeName)
  Dim Cmd
  Dim TargetString
  TargetString = Replace(TargetString, "`", "``")
  TargetString = Replace(TargetString, """", "`""""""")
  Cmd = "PowerShell -Command  -Noexit "" set-executionpolicy remotesigned -scope process -force;[void]([Reflection.Assembly]::LoadWithPartialName(""""""System.Web""""""));[Web.HttpUtility]::UrlEncode(""""""" & TargetString & """"""", [Text.Encoding]::GetEncoding(""""""" & CodeName & """""""))"""
  EncodeURLPS = CreateObject("WScript.Shell").Exec(Cmd).StdOut.ReadLine
End Function
```

なお、powershellを利用したデコードは次のようになります。
参考: http://blog.powershell-from.jp/?p=222

```VB:URLDECODE.VB

Sub test()
Const strUTF8 = "%E3%81%82%E3%81%84%E3%81%86%E3%81%88%E3%81%8A"
Dim str
Dim buf
MsgBox DECodeURLPS(strUTF8)
End Sub

Function DECodeURLPS(ByVal TargetString)
Dim Cmd
  TargetString = Replace(TargetString, "`", "``")
  TargetString = Replace(TargetString, """", "`""""""")
  Cmd = "PowerShell -Command ""[void]([Reflection.Assembly]::LoadWithPartialName(""""""System.Web""""""));[Web.HttpUtility]::UrlDEcode(""""""" & TargetString & """"""")""" ', [Text.Encoding]::GetEncoding(""""""" & CodeName & """""""))"""
  Debug.Print Cmd
  DECodeURLPS = CreateObject("WScript.Shell").Exec(Cmd).StdOut.ReadLine
End Function

```
#さらなる発展形
[64bit版VBAでScriptControlを使用する](https://qiita.com/nukie_53/items/8401232a2d626c7f8078)
[VBAからJScriptのfunctionオブジェクトを使用する（64bit対応）](https://qiita.com/nukie_53/items/297e524bcc8e43f9b5d1)
これはすごい...
[64ビット環境でのScriptControlの代わり](http://www.ka-net.org/office/of32.html)
自分ができるのは参照設定をつけて書き換えることくらいか

```visualbasic
Function EncodeURLMSHTML(ByVal sWord As String) As String
  Dim d As Object
  Dim elm As MSHTML.HTMLSpanElement
  Dim objD As HTMLDocument: Set objD = New MSHTML.HTMLDocument
  sWord = Replace(sWord, "\", "\\")
  sWord = Replace(sWord, "'", "\'")
  Set d = CreateObject("htmlfile")
  Set elm = objD.createElement("span")
  elm.setAttribute "id", "result"
 objD.appendChild elm
  objD.parentWindow.execScript "document.getElementById('result').innerText = encodeURIComponent('" & sWord & "');", "JScript"
  EncodeURLMSHTML = elm.innerText
End Function
```
##Decodeも

```visualbasic
Function DEcodeURLMSHTML(ByVal sWord As String) As String
  Dim d As Object
  Dim elm As MSHTML.HTMLSpanElement
  Dim objD As HTMLDocument: Set objD = New MSHTML.HTMLDocument
  sWord = Replace(sWord, "\", "\\")
  sWord = Replace(sWord, "'", "\'")
  Set d = CreateObject("htmlfile")
  Set elm = objD.createElement("span")
  elm.setAttribute "id", "result"
 objD.appendChild elm
  objD.parentWindow.execScript "document.getElementById('result').innerText = decodeURIComponent('" & sWord & "');", "JScript"
  DEcodeURLMSHTML = elm.innerText
End Function
```
###スラッシュ (/) もエンコードされるので、Web サーバーへの要求として送信する場合は無効になります

[encodeURIComponent 関数 (JavaScript)](https://msdn.microsoft.com/ja-jp/library/aeh9cef7%28v=vs.94%29.aspx?f=255&MSPPError=-2147217396)
>encodeURIComponent 関数では、すべての文字がエンコードされるので、/folder1/folder2/default.html などのパスを表す文字列には注意が必要です。 スラッシュ (/) もエンコードされるので、Web サーバーへの要求として送信する場合は無効になります

###DecodeURIComponetはウソ完全なURIでなくてもよい

[decodeURIComponent 関数 (JavaScript)](https://msdn.microsoft.com/ja-jp/library/91b80x6x%28v=vs.94%29.aspx?f=255&MSPPError=-2147217396)
>構文 encodeURIComponent(encodedURIString)
>encodedURIString 引数は必須で、エンコードされた URI コンポーネントを表す値を指定します。URIComponent は完全な URI の一部です。encodedURIString が無効な場合は URIError が発生します。

<blockquote class="twitter-tweet" data-lang="ja"><p lang="ja" dir="ltr">増毛駅跡地は建て替えられて綺麗になりました<br>線路や駅名標は残っています <a href="https://t.co/PrqH7DvelB">pic.twitter.com/PrqH7DvelB</a></p>&mdash; ウォーリー(4/21-23旭川〜札幌) (@worry787) <a href="https://twitter.com/worry787/status/987903669055049729?ref_src=twsrc%5Etfw">2018年4月22日</a></blockquote>
<script async src="https://platform.twitter.com/widgets.js" charset="utf-8"></script>

というわけでどこにもないユニークで広い場所に１か所だけある増毛駅を例にしてみる

#### google map ChromeのURL欄
`https://www.google.com/maps/place/増毛駅/@43.8572216,141.5249246,17z/data=!3m1!4b1!4m5!3m4!1s0x5f0c7a957115429f:0x6632aaac1fab4098!8m2!3d43.8572178!4d141.5271133?hl=ja`


#### google map VBAやExcelのセルなど

`https://www.google.com/maps/place/%E5%A2%97%E6%AF%9B%E9%A7%85/@43.8572216,141.5249246,17z/data=!3m1!4b1!4m5!3m4!1s0x5f0c7a957115429f:0x6632aaac1fab4098!8m2!3d43.8572178!4d141.5271133?hl=ja`
早速関数をVisual Basic Editorのイミディエイトウィンドウで使ってみる

```visualbasic
?DEcodeURLMSHTML("https://www.google.com/maps/place/%E5%A2%97%E6%AF%9B%E9%A7%85/@43.8572216,141.5249246,17z/data=!3m1!4b1!4m5!3m4!1s0x5f0c7a957115429f:0x6632aaac1fab4098!8m2!3d43.8572178!4d141.5271133?hl=ja")
```

結果
`https://www.google.com/maps/place/増毛駅/@43.8572216,141.5249246,17z/data=!3m1!4b1!4m5!3m4!1s0x5f0c7a957115429f:0x6632aaac1fab4098!8m2!3d43.8572178!4d141.5271133?hl=ja
`
Chromeの欄と同じになる。増毛駅だけが `%E5%A2%97%E6%AF%9B%E9%A7%85` と変わる
それでは次はどうか。公式のヘルプファイルを見るとエラーになりそうだ

```visualbasic
?DEcodeURLMSHTML("%E5%A2%97%E6%AF%9B%E9%A7%85")
```
結果はこのとおり
増毛駅
DecodURIComponentはデコードする部分だけ取り出しても動くのである。

>A URIComponent is part of a complete URI.

完全なURIの一部だけでもデコードできますと訳さないと意味が分かるわけない。この辺が機械翻訳ではできない。


[GlobalObject.decodeURI メソッド (Object)](https://msdn.microsoft.com/ja-jp/library/microsoft.jscript.globalobject.decodeuri%28v=vs.110%29.aspx?f=255&MSPPError=-2147217396)
これが使えれば問題ないのだが