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

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

広告

APIで郵便番号から住所を取得する

今回は郵便専門ネット(http://yubin.senmon.net/service/)のAPIを使ってみます。

Option Explicit

Public Sub TestProc()
  Dim dat As Variant
  Dim oXML As Object
  Dim oNode As Object
  Const URL As String = "http://yubin.senmon.net/service/xmlrpc/"
  
  'XML設定
  dat = "<?xml version=""1.0"" encoding=""utf-8""?>" & vbCrLf
  dat = dat & "<methodCall>" & vbCrLf
  dat = dat & "  <methodName>yubin.fetchAddressByPostcode</methodName>" & vbCrLf
  dat = dat & "  <params>" & vbCrLf
  dat = dat & "    <param>" & vbCrLf
  dat = dat & "      <value>" & vbCrLf
  dat = dat & "        <string>9030815</string>" & vbCrLf
  dat = dat & "      </value>" & vbCrLf
  dat = dat & "    </param>" & vbCrLf
  dat = dat & "  </params>" & vbCrLf
  dat = dat & "</methodCall>"
  
  Set oXML = Nothing '初期化
  On Error Resume Next
  With CreateObject("MSXML2.XMLHTTP")
    .Open "POST", URL, False
    .setRequestHeader "Content-Type", "text/xml"
    .Send dat
    Set oXML = .responseXML
  End With
  On Error GoTo 0
  If oXML Is Nothing Then Exit Sub
  
  '確認用
  For Each oNode In oXML.selectNodes("methodResponse/params/param/value/array/data/value/struct/member")
  '  Debug.Print oNode.xml
    Debug.Print oNode.selectSingleNode("name").Text, oNode.selectSingleNode("value").Text
    Debug.Print "-----"
  Next
  Debug.Print oXML.selectNodes("methodResponse/params/param/value/array/data/value/struct/member[name='pref']/value").Item(0).Text & _
              oXML.selectNodes("methodResponse/params/param/value/array/data/value/struct/member[name='city']/value").Item(0).Text & _
              oXML.selectNodes("methodResponse/params/param/value/array/data/value/struct/member[name='town']/value").Item(0).Text
  Debug.Print oXML.selectNodes("methodResponse/params/param/value/array/data/value/struct/member[name='pref_kana']/value").Item(0).Text & _
              oXML.selectNodes("methodResponse/params/param/value/array/data/value/struct/member[name='city_kana']/value").Item(0).Text & _
              oXML.selectNodes("methodResponse/params/param/value/array/data/value/struct/member[name='town_kana']/value").Item(0).Text
  
End Sub

拡張子判別

割とよく使うのでコピー＆ペースト用にメモ。

Public Sub Sample()
  Dim f As Object
  
  With CreateObject("Scripting.FileSystemObject")
    For Each f In .GetFolder("C:\Windows").Files
      Select Case LCase$(.GetExtensionName(f))
        Case "exe", "ini"
         Debug.Print f.Name, f.Path
      End Select
    Next
  End With
End Sub

CommandBarsオブジェクトのTemporaryが効かない？

CommandBarsオブジェクトやCommandBarControlsオブジェクトのAddメソッドでコントロールを追加するとき、ExcelはTemporaryが効いたけれどWordだと効いていない様子。

今までは適当なタイミングでDeleteしていたので気にしていなかったのですが、ふとしたきっかけで調べてみたのでホームページにアップしました↓

「CommandBarsオブジェクトのTemporaryが効かない？(Word VBA)」
http://www.ka-net.org/office/of43.html

結局はWordの場合はNormal.dotに記録されるので、Normal.dotを汚したくない場合はCustomizationContextプロパティを使えば良い、ってことらしいです。

そんなわけでカスタムコマンドバーを使ったテンプレートを配布する場合は、

1. CustomizationContextプロパティで対象テンプレートを指定してコマンドバーを追加。
2. 1.のファイルを配布。
3. 導入時はスタートアップフォルダにコピー。
4. 削除時はスタートアップフォルダから削除。

のようにすれば、テンプレート削除時の手間(コマンドバーを削除するマクロを走らせる)が減らせそうです。

ずっと前からこういった仕様だったので、知っている人には当たり前だっただろう事柄。
今更ながらに知った私っていったい・・・。
まだまだ知らないことばかりです。

コード投稿のテスト

「sourcecode」なるものを使うとコードの投稿ができるらしいので試してみます。

Public Sub Sample()
  MsgBox "Hello World."
End Sub

あー、なるほど！
便利そうです。

ブログはじめ。

ふと思いついたホームページに載せるほどじゃないネタを載せるためのブログです。

(良いネタだったらホームページに載せるかも？)

 

昔はYahoo!ブログを使っていましたが、私には使いづらかったので別のブログを検討。

Windows Liveのアカウントがあったのでそれを使おうかと思ったら、サービス終わっていたのね・・・。

 

そんなわけで今日からWordPress.comでスタートです。

メインはホームページなので、このブログの更新は適当になるかもしれません。