Archive for the ‘VBScript’ Category

documentModeが9にならない?

2011/05/07

下のソースコードは一般的なHTMLコードで、これをIE9で表示するとドキュメントモードは「IE9」(9)になります。

<!DOCTYPE html>
<html>
<head>
<meta charset="UTF-8">
<meta http-equiv="X-UA-Compatible" content="IE=edge">
</head>
<body>
<p>hoge</p>
</body>
</html>

IE9用に書いたものなので当たり前の動作なのですが、これをVBSで下記のように書くと何故かドキュメントモードが「8」になってしまいます。
(DOCTYPEやX-UA-Compatibleが色々書かれているのは色々試した結果。どれも「9」にならず・・・)

Option Explicit

Dim s

'DOCTYPE
s = "<!DOCTYPE html>" & vbCrLf
's = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0//EN"">" & vbCrLf
's = "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.1//EN"" ""http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"">" & vbCrLf

s = s & "<html>" & vbCrLf
s = s & "<head>" & vbCrLf
s = s & "<meta charset=""UTF-8"">" & vbCrLf

'X-UA-Compatible
s = s & "<meta http-equiv=""X-UA-Compatible"" content=""IE=edge"">" & vbCrLf
's = s & "<meta http-equiv=""X-UA-Compatible"" content=""IE=100"">" & vbCrLf
's = s & "<meta http-equiv=""X-UA-Compatible"" content=""IE=IE9"">" & vbCrLf
's = s & "<meta http-equiv=""X-UA-Compatible"" content=""IE=EmulateIE9"">" & vbCrLf
's = s & "<meta http-equiv=""X-UA-Compatible"" content=""IE=9"">" & vbCrLf
's = s & "<meta http-equiv=""X-UA-Compatible"" content=""IE=9; IE=8; IE=5"">" & vbCrLf

s = s & "</head>" & vbCrLf
s = s & "<body>" & vbCrLf
s = s & "<p>hoge</p>" & vbCrLf
s = s & "</body>" & vbCrLf
s = s & "</html>" & vbCrLf

With CreateObject("htmlfile")
  .clear
  .open
  .write s
  .close
  
  MsgBox "userAgent:" & .parentWindow.clientInformation.userAgent & vbCrLf & _
         "documentMode:" & .documentMode
End With

下位のドキュメントモードには設定できるのですが、う~ん・・・。謎です。
他に設定しないといけないところがあるのかなぁ・・・(?_?)

災害ボランティア検索APIをVBScriptから呼び出す

2011/04/27

災害ボランティア検索APIをVBScriptから呼び出してみます(エラー処理等手抜き)。
※ 要アプリケーションID

Option Explicit

Dim oXML
Dim oNode
Dim url
Dim status
Dim q '検索クエリー
Const AppID = "(アプリケーションID)" 'アプリケーションID

q = InputBox("検索文字列を入力してください。")
If IsEmpty(q) Then WScript.Quit
If q = "" Then WScript.Quit

url = "http://shinsai.yahooapis.jp/v1/volunteers?appid=" & AppID & "&query=" & EncodeURL(q)
Set oXML = GetXMLDocument(url)
If oXML Is Nothing Then WScript.Quit

WScript.Echo "■災害ボランティア情報(検索キーワード:" & q & ")"
WScript.Echo "--------------------"
On Error Resume Next
For Each oNode In oXML.SelectNodes("/Messages/Message")
  status = oNode.SelectSingleNode("Status").Text
  Select Case CInt(status)
    Case 0
      status = "募集終了"
    Case 1
      status = "現在募集中"
    Case Else
      status = "募集状況不明"
  End Select
  WScript.Echo "募集メッセージのタイトル:" &  oNode.SelectSingleNode("Title").Text & "(" & status & ")"
  WScript.Echo "情報が最後に変更された時間:" &  oNode.SelectSingleNode("UpdateTime").Text
  WScript.Echo "場所:" &  oNode.SelectSingleNode("Address").Text
  WScript.Echo "組織名:" &  oNode.SelectSingleNode("Organization").Text
  WScript.Echo "募集メッセージ:"
  WScript.Echo oNode.SelectSingleNode("Body").Text
  WScript.Echo "--------------------"
Next
If Err.Number <> 0 Then
  WScript.Echo "エラーが発生しました。"
  WScript.Echo "内容:" & Err.Description
  Err.Clear
End If
On Error GoTo 0
Set oXML = Nothing

Public Function GetXMLDocument(ByVal url)
'XML取得
  Dim oXML
  
  On Error Resume Next
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", url, False
    .Send
    Set oXML = .responseXML
  End With
  If Err.Number <> 0 Then
    Set oXML = Nothing
    Err.Clear
  End If
  On Error GoTo 0
  Set GetXMLDocument = oXML
End Function

Public Function EncodeURL(ByVal sWord)
'URLエンコード
  Dim d
  Dim elm
  
  sWord = Replace(sWord, "\", "\\")
  sWord = Replace(sWord, "'", "\'")
  Set d = CreateObject("htmlfile")
  Set elm = d.createElement("span")
  elm.setAttribute "id", "result"
  d.appendChild elm
  d.parentWindow.execScript "document.getElementById('result').innerText = encodeURIComponent('" & sWord & "');", "JScript"
  EncodeURL = elm.innerText
End Function

結果はリダイレクトで受け取るのが良さそうです。

MP3の情報を取得するVBScript

2011/04/24

※ Windows 7にて実行。
MP3ファイルからタイトルやアーティスト名などを取得するには?[C#、VB] 参照

Option Explicit

Dim itm

With CreateObject("Shell.Application").Namespace("C:\Users\Public\Music\Sample Music")
  For Each itm In .Items
    If InStr(LCase(itm.Type), "mp3") Then
      WScript.Echo itm.Name & " , ファイルサイズ:" & .GetDetailsOf(itm, 1)
      WScript.Echo itm.Name & " , ファイルの種類:" & .GetDetailsOf(itm, 2)
      WScript.Echo itm.Name & " , 更新日時:" & .GetDetailsOf(itm, 3)
      WScript.Echo itm.Name & " , 作成日時:" & .GetDetailsOf(itm, 4)
      WScript.Echo itm.Name & " , アクセス日時:" & .GetDetailsOf(itm, 5)
      WScript.Echo itm.Name & " , 属性:" & .GetDetailsOf(itm, 6)
      WScript.Echo itm.Name & " , 所有者:" & .GetDetailsOf(itm, 10)
      WScript.Echo itm.Name & " , 参加アーティスト:" & .GetDetailsOf(itm, 13)
      WScript.Echo itm.Name & " , アルバム:" & .GetDetailsOf(itm, 14)
      WScript.Echo itm.Name & " , 年:" & .GetDetailsOf(itm, 15)
      WScript.Echo itm.Name & " , ジャンル:" & .GetDetailsOf(itm, 16)
      WScript.Echo itm.Name & " , 指揮者:" & .GetDetailsOf(itm, 17)
      WScript.Echo itm.Name & " , 評価:" & .GetDetailsOf(itm, 19)
      WScript.Echo itm.Name & " , 参加アーティスト:" & .GetDetailsOf(itm, 20)
      WScript.Echo itm.Name & " , タイトル:" & .GetDetailsOf(itm, 21)
      WScript.Echo itm.Name & " , コメント:" & .GetDetailsOf(itm, 24)
      WScript.Echo itm.Name & " , トラック番号:" & .GetDetailsOf(itm, 26)
      WScript.Echo itm.Name & " , 長さ:" & .GetDetailsOf(itm, 27)
      WScript.Echo itm.Name & " , ビット レート:" & .GetDetailsOf(itm, 28)
      WScript.Echo itm.Name & " , コンピューター:" & .GetDetailsOf(itm, 53)
      WScript.Echo itm.Name & " , 名前:" & .GetDetailsOf(itm, 155)
      WScript.Echo itm.Name & " , フォルダーのパス:" & .GetDetailsOf(itm, 177)
      WScript.Echo itm.Name & " , 項目の種類:" & .GetDetailsOf(itm, 182)
      WScript.Echo itm.Name & " , エンコード方式:" & .GetDetailsOf(itm, 193)
      WScript.Echo itm.Name & " , 発行元:" & .GetDetailsOf(itm, 195)
      WScript.Echo itm.Name & " , サブタイトル:" & .GetDetailsOf(itm, 196)
      WScript.Echo itm.Name & " , アルバムのアーティスト:" & .GetDetailsOf(itm, 217)
      WScript.Echo itm.Name & " , ビート数/分:" & .GetDetailsOf(itm, 219)
      WScript.Echo itm.Name & " , 作曲者:" & .GetDetailsOf(itm, 220)
      WScript.Echo itm.Name & " , イニシャル キー:" & .GetDetailsOf(itm, 221)
      WScript.Echo itm.Name & " , コンパイルの一部:" & .GetDetailsOf(itm, 222)
      WScript.Echo itm.Name & " , 雰囲気:" & .GetDetailsOf(itm, 223)
      WScript.Echo itm.Name & " , セットのパート:" & .GetDetailsOf(itm, 224)
      WScript.Echo itm.Name & " , サブタイトル:" & .GetDetailsOf(itm, 254)
      WScript.Echo itm.Name & " , 共有ユーザー:" & .GetDetailsOf(itm, 268)
    End If
  Next
End With

ウィンドウの切り替えを実行するVBScript

2011/04/24

※ Vista以降限定

CreateObject("Shell.Application").WindowSwitcher()

VBScriptからWindows API関数を呼び出す

2011/04/17

VBSからAPI関数を呼び出す方法として、別途作成したDLL経由で呼び出す方法や”SFC mini“、”DynaCall“といったツールを使う方法がありますが、わりとよく使われるのが『Excel経由でCALL関数を使って呼び出す』方法です。

Dim h

CreateObject("WScript.Shell").Run "notepad", 1, False
With CreateObject("Excel.Application")
  h = .ExecuteExcel4Macro("CALL(""user32"", ""FindWindowA"", ""JCJ"", ""Notepad"", 0)")
  If h = 0 Then WScript.Quit
  Call .ExecuteExcel4Macro("CALL(""user32"", ""SendMessageA"", ""JJJJJ"", " & h & ", 273, 65, 0)")
End With

上記コードを見るとExecuteExcel4MacroメソッドでExcel4.0マクロ関数を実行しているようですが、ここで使われているのが実は「CALL」関数です。この関数の引数でAPI関数名やDLL名を指定しているわけです。

CALL(モジュール名, プロシージャ名, タイプ, [引数 1], …, [引数 n])

CALL 関数」より

第一引数でモジュール名、第二引数で関数名、これはすぐ分かると思いますが、問題なのが第三引数。上記コードを見ると「JJJJJ」となっていて、これが一体何を表しているのかよく分からない人も多いだろうと思います。
そこでMicrosoftの説明ページを見てみると、下記のような記述があります。

“タイプ” の先頭の文字では、戻り値のデータ型を指定します。残りの文字では、すべての引数のデータ型を指定します。たとえば、戻り値が浮動小数点数、引数が整数と浮動小数点数である DLL 関数は、”タイプ” 引数として “BIB” を取ります。

この「JJJJJ」というのは戻り値と引数のデータ型を文字列で表しているわけです。

そこで、改めて上記コードが一体どのような処理を行っているのかというと、

1. メモ帳を起動します。
2. FindWindowでメモ帳のウィンドウハンドルを取得します。
3. 2.で取得したハンドルを元にウィンドウに対してSendMessageでWM_COMMAND(&H111(273))、wParam:&H41(65)を送り、メモ帳のバージョン情報を表示します。

といった処理を行っているわけです。

上記のようなVBSからAPI関数を呼び出す処理は、ウィンドウズスクリプトプログラマさんのブログ「Windows Script Programming」にて多数紹介されていますので、興味がある方は参考にされてはいかがでしょうか。

ドラッグされたマネージドDLLをRegAsmで登録するスクリプト

2011/04/07

supermabさんのブログの記事「Excel から使うマネージDLL を作る。」、ここまで丁寧に解説されたサイトは少ないので非常に参考になります。
ただ、記事中にも書かれていますがDLLの登録・登録解除がどうしても手間になってしまいます。

XPであれば特に大きな問題は無いのですが、Vista以降UACが絡んでくる都合上、一工夫する必要がありそうです。
では具体的にどうするか?パッと思いつくのは「runas」付きでShellExecuteメソッドを実行する方法。
早速試してみました。

'*********************************************************
' ドラッグされたマネージドDLLをRegAsmで登録するスクリプト
' 
' 2011/04/05 kinuasa
'*********************************************************

Option Explicit

Dim Args
Dim FSO
Dim f
Dim DllFilePath
Dim WindowsFolderPath
Dim FrameworkFolderPath
Dim SubFrameworkFolderPath
Dim RegAsmFilePath
Dim ArgStr
Const Opt = " /tlb /codebase" 'RegAsmに渡すオプション
Const MsgTitle = "RegAsm実行"

RegAsmFilePath = "" '初期化

Set Args = WScript.Arguments
If Args.Count < 1 Then
  MsgBox "DLLを当スクリプトファイルにドラッグ&ドロップして処理を実行してください。", 16, MsgTitle
  WScript.Quit
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
Select Case LCase(FSO.GetExtensionName(Args(0)))
  Case "dll"
    DllFilePath = Args(0)
  Case Else
    MsgBox "DLLを当スクリプトファイルにドラッグ&ドロップして処理を実行してください。", 16, MsgTitle
    WScript.Quit
End Select
Set Args = Nothing

'.NET Frameworkフォルダのパス取得
WindowsFolderPath = FSO.GetSpecialFolder(0).Path
If Right(WindowsFolderPath, 1) <> "\" Then WindowsFolderPath = WindowsFolderPath & "\"
FrameworkFolderPath = WindowsFolderPath & "Microsoft.NET\Framework\"
If FSO.FolderExists(FrameworkFolderPath) <> True Then
  MsgBox ".NET Frameworkフォルダが見つかりませんでした。" & vbCrLf & _
         "処理を中止します。", 16, MsgTitle
  WScript.Quit
End If
'RegAsm.exeのパス取得
With CreateObject("ADODB.Recordset")
  .Fields.Append "Path", 200, 255
  .Open
  For Each f In FSO.GetFolder(FrameworkFolderPath).SubFolders
    .AddNew
    .Fields("Path").Value = f.Path
    .Update
  Next
  .Sort = "Path DESC" 'Framework各バージョンフォルダ名を降順ソート
  .MoveFirst
  Do Until .EOF
    SubFrameworkFolderPath = .Fields(0)
    If Right(SubFrameworkFolderPath, 1) <> "\" Then SubFrameworkFolderPath = SubFrameworkFolderPath & "\"
    If FSO.FileExists(SubFrameworkFolderPath & "RegAsm.exe") Then
      If MsgBox("[" & SubFrameworkFolderPath & "RegAsm.exe]で登録しますか?", vbYesNo, MsgTitle) = vbYes Then
        RegAsmFilePath = SubFrameworkFolderPath & "RegAsm.exe"
        Exit Do
      End If
    End If
    .MoveNext
  Loop
  .Close
End With
Set FSO = Nothing
If Len(RegAsmFilePath) < 1 Then
  MsgBox "[RegAsm.exe]が見つかりませんでした。" & vbCrLf & _
         "処理を中止します。", 16, MsgTitle
  WScript.Quit
End If

ArgStr = """" & DllFilePath & """" & Opt
CreateObject("Shell.Application").ShellExecute RegAsmFilePath, ArgStr, "", "runas" 'runas付きで実行
'*************************************************************
' ドラッグされたマネージドDLLをRegAsmで登録解除するスクリプト
' 
' 2011/04/05 kinuasa
'*************************************************************

Option Explicit

Dim Args
Dim FSO
Dim f
Dim DllFilePath
Dim WindowsFolderPath
Dim FrameworkFolderPath
Dim SubFrameworkFolderPath
Dim RegAsmFilePath
Dim ArgStr
Const Opt = " /tlb /u" 'RegAsmに渡すオプション
Const MsgTitle = "RegAsm実行"

RegAsmFilePath = "" '初期化

Set Args = WScript.Arguments
If Args.Count < 1 Then
  MsgBox "DLLを当スクリプトファイルにドラッグ&ドロップして処理を実行してください。", 16, MsgTitle
  WScript.Quit
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
Select Case LCase(FSO.GetExtensionName(Args(0)))
  Case "dll"
    DllFilePath = Args(0)
  Case Else
    MsgBox "DLLを当スクリプトファイルにドラッグ&ドロップして処理を実行してください。", 16, MsgTitle
    WScript.Quit
End Select
Set Args = Nothing

'.NET Frameworkフォルダのパス取得
WindowsFolderPath = FSO.GetSpecialFolder(0).Path
If Right(WindowsFolderPath, 1) <> "\" Then WindowsFolderPath = WindowsFolderPath & "\"
FrameworkFolderPath = WindowsFolderPath & "Microsoft.NET\Framework\"
If FSO.FolderExists(FrameworkFolderPath) <> True Then
  MsgBox ".NET Frameworkフォルダが見つかりませんでした。" & vbCrLf & _
         "処理を中止します。", 16, MsgTitle
  WScript.Quit
End If
'RegAsm.exeのパス取得
With CreateObject("ADODB.Recordset")
  .Fields.Append "Path", 200, 255
  .Open
  For Each f In FSO.GetFolder(FrameworkFolderPath).SubFolders
    .AddNew
    .Fields("Path").Value = f.Path
    .Update
  Next
  .Sort = "Path DESC" 'Framework各バージョンフォルダ名を降順ソート
  .MoveFirst
  Do Until .EOF
    SubFrameworkFolderPath = .Fields(0)
    If Right(SubFrameworkFolderPath, 1) <> "\" Then SubFrameworkFolderPath = SubFrameworkFolderPath & "\"
    If FSO.FileExists(SubFrameworkFolderPath & "RegAsm.exe") Then
      If MsgBox("[" & SubFrameworkFolderPath & "RegAsm.exe]で登録解除しますか?", vbYesNo, MsgTitle) = vbYes Then
        RegAsmFilePath = SubFrameworkFolderPath & "RegAsm.exe"
        Exit Do
      End If
    End If
    .MoveNext
  Loop
  .Close
End With
Set FSO = Nothing
If Len(RegAsmFilePath) < 1 Then
  MsgBox "[RegAsm.exe]が見つかりませんでした。" & vbCrLf & _
         "処理を中止します。", 16, MsgTitle
  WScript.Quit
End If

ArgStr = """" & DllFilePath & """" & Opt
CreateObject("Shell.Application").ShellExecute RegAsmFilePath, ArgStr, "", "runas" 'runas付きで実行

上記スクリプトにDLLファイルをドラッグ&ドロップ。
tlbファイルを出力されて、VBAからでも使うことが出来ました。
なかなか上手くいっていそうです。

上記スクリプトをZip形式で圧縮したのがコチラ

インストールされているウィルス対策ソフトの情報を列挙するVBScript

2011/04/06

使い道は不明です。

Option Explicit

Dim colItems
Dim oItem

On Error Resume Next
Set colItems = CreateObject("WbemScripting.SWbemLocator") _
              .ConnectServer(".", "root\SecurityCenter2") _
              .ExecQuery("Select * from AntiVirusProduct")
For Each oItem In colItems
  WScript.Echo "displayName:" & oItem.displayName
  WScript.Echo "instanceGuid:" & oItem.instanceGuid
  WScript.Echo "pathToSignedProductExe:" & oItem.pathToSignedProductExe
  WScript.Echo "pathToSignedReportingExe:" & oItem.pathToSignedReportingExe
  WScript.Echo "productState:" & oItem.productState
Next
Set colItems = Nothing

If Err.Number <> 0 Then
  Set colItems = CreateObject("WbemScripting.SWbemLocator") _
                .ConnectServer(".", "root\SecurityCenter") _
                .ExecQuery("Select * from AntiVirusProduct")
  For Each oItem In colItems
    WScript.Echo "companyName:" & oItem.companyName
    WScript.Echo "displayName:" & oItem.displayName
    WScript.Echo "enableOnAccessUIMd5Hash:" & oItem.enableOnAccessUIMd5Hash
    WScript.Echo "enableOnAccessUIParameters:" & oItem.enableOnAccessUIParameters
    WScript.Echo "instanceGuid:" & oItem.instanceGuid
    WScript.Echo "onAccessScanningEnabled:" & oItem.onAccessScanningEnabled
    WScript.Echo "pathToEnableOnAccessUI:" & oItem.pathToEnableOnAccessUI
    WScript.Echo "pathToUpdateUI:" & oItem.pathToUpdateUI
    WScript.Echo "productUptoDate:" & oItem.productUptoDate
    WScript.Echo "updateUIMd5Hash:" & oItem.updateUIMd5Hash
    WScript.Echo "updateUIParameters:" & oItem.updateUIParameters
    WScript.Echo "versionNumber:" & oItem.versionNumber
  Next
  Set colItems = Nothing
  Err.Clear
End If
On Error GoTo 0

Yahoo!知恵袋Web APIをVBScriptから呼び出す

2011/03/07

Yahoo!知恵袋Web APIをVBScriptから呼び出してみます。
※ 要アプリケーションID

Option Explicit

ShowChiebukuroList "2078297489", "open" 'Yahoo!知恵袋(Office系(Word、Excel))回答受付中の質問を列挙

Sub ShowChiebukuroList(ByVal CategoryId, ByVal Condition)
  Dim oXML
  Dim oNode
  Dim url
  Const AppID = "(アプリケーションID)" 'アプリケーションID
  
  Select Case LCase(Condition)
    Case "open", "vote", "solved"
    Case Else
      WScript.Echo "パラメータを確認してください。"
      Exit Sub
  End Select
  
  url = "http://chiebukuro.yahooapis.jp/Chiebukuro/V1/getNewQuestionList?output=xml&condition=" & Condition & "&sort=-updateddate&results=20&category_id=" & CategoryId & "&appid=" & AppID
  Set oXML = Nothing '初期化
  On Error Resume Next
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", url, False
    .Send
    Set oXML = .responseXML
  End With
  Err.Clear
  On Error GoTo 0
  If oXML Is Nothing Then
    WScript.Echo "XMLが取得できませんでした。処理を中止します。"
    Exit Sub
  End If
  If oXML.getElementsByTagName("Error").Length > 0 Then
    WScript.Echo "エラーが発生しました。処理を中止します。"
    Exit Sub
  End If
  
  WScript.Echo "--------------------"
  For Each oNode In oXML.SelectNodes("/ResultSet/Result")
    WScript.Echo "質問内容:" & oNode.SelectSingleNode("Content").Text
    WScript.Echo "回答数:" & oNode.SelectSingleNode("AnsCount").Text
    WScript.Echo "お礼コイン枚数:" & oNode.SelectSingleNode("Coin").Text
    WScript.Echo "カテゴリ:" & oNode.SelectSingleNode("Category").Text
    WScript.Echo "URL:" & oNode.SelectSingleNode("QuestionUrl").Text
    WScript.Echo "更新日時:" & oNode.SelectSingleNode("UpdatedDate").Text
    WScript.Echo "--------------------"
  Next
End Sub

64ビットで実行した場合は32ビットで再実行するVBScript

2011/02/27

ScriptControl他、64ビット環境では実行できない場合に使えるかもしれません。
ScriptControlの場合は下記ページのような代替方法も有り。

「64ビット環境でのScriptControlの代わり」
http://www.ka-net.org/office/of32.html

Option Explicit

'64ビットで実行した場合は32ビットで再実行する
With CreateObject("WScript.Shell")
  If (InStr(.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%"), "64")) And _
     (InStr(LCase(WScript.FullName), "system32")) Then
    Dim ExeName
    Dim ExePath
    Dim SysFolderPath
    
    ExeName = Mid(WScript.FullName, InStrRev(WScript.FullName, "\") + 1)
    With CreateObject("Scripting.FileSystemObject")
      SysFolderPath = .GetSpecialFolder(0).Path
      ExePath = SysFolderPath & "\SysWOW64\" & ExeName
      If .FileExists(ExePath) <> True Then
        MsgBox "SysWOW64フォルダ内に " & ExeName & " が見つかりませんでした。" & vbCrLf & _
               "処理を中止します。", 16
        WScript.Quit
      End If
    End With
    .Run """" & ExePath & """" & " " & """" & WScript.ScriptFullName & """"
    WScript.Quit
  End If
End With

'MsgBox CreateObject("WScript.Shell").ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%") & vbCrLf & WScript.FullName '確認用
MsgBox EncodeURL("初心者備忘録")

Private Function EncodeURL(ByVal sWord)
  With CreateObject("ScriptControl")
    .Language = "JScript"
    EncodeURL = .CodeObject.encodeURIComponent(sWord)
  End With
End Function