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

More than 1 year has passed since last update.


Scriptcontrolが64bitは使えない

64ビット環境でのScriptControlの代わり

まあそんな感じで悩んでいたのですが、 なんだあるじゃないか。 EXCEL2010 64bit版までの悩みだったようです。EXCEL2010 64bitをお使いの場合はPowershell版を使うなどの必要がありましたが、Excel 2013 以降では解消されています。これでユーザーファンクションを組むとURLエンコードが可能になります。

アクセスでも使えるようにCreateobjectしたものとvbscriptも作っておきました。


VBA


For ACCESS


fnURLENCODE2013.VB

Function fnURLENCODE2013(str as String)

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を参照設定したアクセスで使える関数です


fnURLENCODE2013.VB

Function fnURLENCODE2013(str as String)

Dim xlApp As New Excel.Application
fnURLENCODE2013 = xlApp.WorksheetFunction.EncodeURL(str)
End Function


VBS

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


fnURLENCODE2013.VB

Function fnURLENCODE2013(str)

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


注意

もちろんこれはEXCEL 2013 がないとだめです。

ENCODEURL関数


ところで、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


MakeGoogleSerchString.VB

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が完全に表示されます。


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を入れているより早く閉まるようになりました。


MakeGoogleSerchString.VB

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


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を使用する

VBAからJScriptのfunctionオブジェクトを使用する(64bit対応)

これはすごい...

64ビット環境でのScriptControlの代わり

自分ができるのは参照設定をつけて書き換えることくらいか

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も

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)


encodeURIComponent 関数では、すべての文字がエンコードされるので、/folder1/folder2/default.html などのパスを表す文字列には注意が必要です。 スラッシュ (/) もエンコードされるので、Web サーバーへの要求として送信する場合は無効になります



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

decodeURIComponent 関数 (JavaScript)


構文 encodeURIComponent(encodedURIString)

encodedURIString 引数は必須で、エンコードされた URI コンポーネントを表す値を指定します。URIComponent は完全な URI の一部です。encodedURIString が無効な場合は URIError が発生します。


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

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


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

早速関数をイミディエイトウィンドウで使ってみる

?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 と変わる

それでは次はどうか。公式のヘルプファイルを見るとエラーになりそうだ

?DEcodeURLMSHTML("%E5%A2%97%E6%AF%9B%E9%A7%85")

結果はこのとおり

増毛駅

DecodURIComponentはデコードする部分だけ取り出しても動くのである。


A URIComponent is part of a complete URI.


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

GlobalObject.decodeURI メソッド (Object)

これが使えれば問題ないのだが