fc2ブログ

Notesクライアントで郵便番号検索(続き)

前回のNotesクライアントで郵便番号検索 にハンドリングを入れたソースです。

Sub Click(Source As Button)
  Dim UIWorkspace As New NotesUIWorkspace
  Dim UIDocument As NotesUIDocument
  Dim XMLHttp As Variant
  Dim ScriptControl As Variant
  Dim Regex As Variant
  
  Set UIDocument = UIWorkspace.CurrentDocument
  Set Regex = CreateObject("VBScript.RegExp")
  Regex.Ignorecase = False
  Regex.Global = True
  Regex.Pattern = "^[0-9]{3}[\-]?[0-9]{4}$"
  Call UIDocument.FieldSetText("YUBIN_NO", Strconv(Trim(UIDocument.FieldGetText("YUBIN_NO")), 8))
  If Regex.Test(UIDocument.FieldGetText("YUBIN_NO")) Then
    Set XMLHttp = CreateObject("MSXML2.XMLHTTP")
    Call XMLHttp.Open("GET", "http://zip.ricollab.jp/" & UIDocument.FieldGetText("YUBIN_NO") & ".json", False)
    Call XMLHttp.SetRequestHeader("Content-Type", "application/x-www-form-urlencoded; charset=UTF-8")
    Call XMLHttp.Send(Null)
    If XMLHttp.ReadyState = 4 And XMLHttp.Status = 200 Then
      Set ScriptControl = CreateObject("ScriptControl")
      ScriptControl.Language = "JScript"
      Call UIDocument.FieldSetText("ZYUSYO", ScriptControl.Eval("(" + _
      XMLHttp.ResponseText + "['address']['prefecture']" + ") + (" + _
      XMLHttp.ResponseText + "['address']['city']" + ") + (" + _
      XMLHttp.ResponseText + "['address']['town']" + ")"))
      Call UIDocument.GotoField("ZYUSYO")
    Else
      Call UIDocument.GotoField("YUBIN_NO")
      Msgbox "住所を取得できませんでした。", 48, UIDocument.WindowTitle
    End If
  Else
    Call UIDocument.GotoField("YUBIN_NO")
    Msgbox "郵便番号は9999999または999-9999の形式で入力して下さい。", 48, UIDocument.WindowTitle
  End If
End Sub

郵便番号のチェックはLikeではなく、VBScript.RegExpで正規表現を使っています。ちなみに当社クライアント環境は6.5(Windows2000)。必ず7桁必須でなく、例えば3桁入れて実行して複数の住所をNotesUIWorkspace.PromptのOKCANCELLISTで選択できればいいなぁと思いましたが、ここでタイムアップ。どなたか是非お願いします。

こちらのチャレンジも是非!

クイズ よりぬき!サントリー2009
クイズ よりぬき!サントリー2009


更に追記ですが、このブログを社内のおっくんが見て、隣の席からメールをくれました。
実行した画面とソースは下記の通り、素晴らしい!

郵便番号検索

Sub Click(Source As Button)
  Dim UIWorkspace As New NotesUIWorkspace
  Dim UIDocument As NotesUIDocument
  Dim XMLHttp As Variant
  Dim ScriptControl As Variant
  Dim Regex As Variant
  Dim i As Long
  Dim x As Long
  Dim r As Long
  Dim Results() As String
  Dim Selected As String
  Dim IsFull   As Boolean

  Set UIDocument = UIWorkspace.CurrentDocument
  Set Regex = CreateObject("VBScript.RegExp")
  Regex.Ignorecase = False
  Regex.Global = True
  Call UIDocument.FieldSetText("YUBIN_NO", Strconv(Trim(UIDocument.FieldGetText("YUBIN_NO")), 8))
  Regex.Pattern = "^[0-9]{3}[\-]?[0-9]{4}$"
  IsFull = Regex.Test(UIDocument.FieldGetText("YUBIN_NO"))
  Regex.Pattern = "^[0-9]{3}[\-]?[0-9]{0,4}$"
  If Regex.Test(UIDocument.FieldGetText("YUBIN_NO")) Then
    Call UIDocument.FieldClear("ZYUSYO")
    Set XMLHttp = CreateObject("MSXML2.XMLHTTP")
    Call XMLHttp.Open("GET", "http://zip.ricollab.jp/" & UIDocument.FieldGetText("YUBIN_NO") & ".json?count=100", False)
    Call XMLHttp.SetRequestHeader("Content-Type", "application/x-www-form-urlencoded; charset=UTF-8")
    Call XMLHttp.Send(Null)
    If XMLHttp.ReadyState = 4 And XMLHttp.Status = 200 Then
      Set ScriptControl = CreateObject("ScriptControl")
      ScriptControl.Language = "JScript"
      If IsFull Then
        Call UIDocument.FieldSetText("ZYUSYO", ScriptControl.Eval("(" + _
        XMLHttp.ResponseText + "['address']['prefecture']" + ") + (" + _
        XMLHttp.ResponseText + "['address']['city']" + ") + (" + _
        XMLHttp.ResponseText + "['address']['town']" + ")"))
      Else
        x = ScriptControl.Eval("(" & XMLHttp.ResponseText & "['result']).length")
        For i = 0 To x - 1
          Redim Preserve Results(r)
          Results(r) = ScriptControl.Eval("(" & XMLHttp.ResponseText & "['result'][" & i & "].zipcode) + ' ' + " & _
          "(" & XMLHttp.ResponseText & "['result'][" & i & "].address)")
          r = r + 1
        Next
        If r > 0 Then
          Selected = UIWorkspace.Prompt(4, UIDocument.FieldGetText("YUBIN_NO") & " の検索結果: " & x & " 件(最大 100件まで)", "住所を選択してください。", , Results)
          If Len(Selected) > 0 Then
            Call UIDocument.FieldSetText("ZYUSYO", Mid(Selected, 9))
          End If
        Else
          Msgbox "該当する住所が見つかりませんでした。", 48, UIDocument.WindowTitle
        End If
      End If
    Else
      Call UIDocument.GotoField("YUBIN_NO")
      Msgbox "住所を取得できませんでした。", 48, UIDocument.WindowTitle
    End If
  Else
    Call UIDocument.GotoField("YUBIN_NO")
    Msgbox "郵便番号は 3桁以上入力してください。", 48, UIDocument.WindowTitle
  End If
End Sub

彼曰く、「ソース長くて汚いので、ブログへのコメントは勘弁してください。関数を追加して連想配列等で取れるかなと思ったのですがうまくいきませんでした。VBA では普通に取得できたので、方法はあると思うのですが・・・。」とのこと。
何故、ここでVBAとLotusScriptで違いがでるのか私もわかりません。

Set ScriptControl = CreateObject("ScriptControl")
ScriptControl.Language = "JScript"
FuncExp = "function jsonParse(s) { return eval('(' + s + ')'); }"
ScriptControl.AddCode("function jsonParse(s) { return eval('(' + s + ')'); }")
Set JSON = ScriptControl.Run("jsonParse", XMLHttp.ResponseText)
Msgbox JSON.address.town
スポンサーサイト



テーマ : プログラミング
ジャンル : コンピュータ

Notesクライアントで郵便番号検索

開発案件を整理していたところ、「郵便番号を入力したら住所を出して欲しい」という案件がありました。優先度は低いのですが、最近は予実など管理業務ばかりでフラストレーションが溜まっていたし、ホームページのお問い合わせ画面のロジックを使えるということもあり作ってみました。
利用させてもらうWebサービスは、 ricollab

(1) フォームに項目とボタンを用意

郵便番号検索

(2) ボタンのClickイベントに下記のLotusScriptを記述。

Sub Click(Source As Button)
  Dim UIWorkspace As New NotesUIWorkspace
  Dim UIDocument As NotesUIDocument
  Dim XMLHttp As Variant
  Dim ScriptControl As Variant

  Set UIDocument = UIWorkspace.CurrentDocument
  Set XMLHttp = CreateObject("MSXML2.XMLHTTP")
  Call XMLHttp.Open("GET", "http://zip.ricollab.jp/" & UIDocument.FieldGetText("YUBIN_NO") & ".json", False)
  Call XMLHttp.SetRequestHeader("Content-Type", "application/x-www-form-urlencoded; charset=UTF-8")
  Call XMLHttp.Send(Null)
  If XMLHttp.ReadyState = 4 And XMLHttp.Status = 200 Then
    Set ScriptControl = CreateObject("ScriptControl")
    ScriptControl.Language = "JScript"
    Call UIDocument.FieldSetText("ZYUSYO", ScriptControl.Eval("(" + _
    XMLHttp.ResponseText + "['address']['prefecture']" + ") + (" + _
    XMLHttp.ResponseText + "['address']['city']" + ") + (" + _
    XMLHttp.ResponseText + "['address']['town']" + ")"))
  Else
    Msgbox "郵便番号を取得できませんでした。"
  End If
End Sub

結果は下記の通り。郵便番号を入力してボタンをクリックすると、住所が入ります。

郵便番号検索

ricollabはXHTMLとJSONフォーマットを提供してくれてます。LotusScriptでは、どちらも文字列操作を駆使しなければなりません。そこでLotusScriptからJavaScriptを動かし、JSONから住所情報を抽出しました。JSONフォーマットは使い勝手が良く便利なため、LotusScriptでも気軽に使えるようになればいいのですが。

こので時点で、NotesクライアントでJavaScriptが使えることを思い出しました。最初に知ったときは「alertが出た」「document.forms[0]で値が入る」など実験したものの、今まで全く利用価値を見出すことができませんでした。そこでボタンのClickイベントで言語をJavaScriptにして下記を実行してみると

var o = new ActiveXObject("Msxml2.XMLHTTP");

new XMLHttpRequest();
o.open("POST", "http://zip.ricollab.jp/4228045", False);
o.send(null);
if ((o.readyState == 4) && (o.status == 200)) {
document.forms[0].ZYUSYO.value = o.responseText.address.prefecture + o.responseText.address.city + o.responseText.address.town;
} else {
alert("住所を取得できませんでした。");
}

ActiveXObjectでエラーになる。それならば"var o = new XMLHttpRequest();"としてみるが、XMLHttpRequestでエラー。クライアントのロケーションのインターネットブラウザは"Microsoft Internet Explorer"としてあるのに。NotesクライアントのJavaScriptは、Notesブラウザ?

以下は開発とは別の話。
いつもまめに懸賞へ応募しています。おこづかいが少ないので、たまにビールが当たって送られてくると嬉しくて涙が出てきます。今回サントリーの懸賞で「ブログを持っている方はWチャンス」で、ブログにバナーを貼って輪を広げると金麦6本を上位20名とのこと。もっと真剣にブログに取り組んでいればよかった。
是非、こちらからチャレンジして下さい。

クイズ よりぬき!サントリー2009
クイズ よりぬき!サントリー2009

テーマ : プログラミング
ジャンル : コンピュータ

プロフィール

ピヨパパ

Author:ピヨパパ
静岡市のエンドユーザーSE。
最近はDominoの開発ばかりでうんざり。
是非気軽にコメントして下さい。

FC2カウンター
最新記事
最新コメント
最新トラックバック
月別アーカイブ
カテゴリ
検索フォーム
RSSリンクの表示
リンク
ブロとも申請フォーム

この人とブロともになる