LoginSignup
5
7

More than 3 years have passed since last update.

@Q11Q

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

Last updated at Posted at 2016-12-23

Scriptcontrolが64bitは使えない

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

VBA

For ACCESS

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

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以降がインストールされている場合、こちらを使うことができます。

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関数

謎

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

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

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

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

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 が発生します。

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

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のイミディエイトウィンドウで使ってみる

?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)
これが使えれば問題ないのだが

5
7
3

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
5
7