Access郵便番号辞書を最新にする方法(叙述トリック)

ACCESS、VBA PC

たまにAccess入れてるところから住所入力支援の郵便番号最新にできないかと問い合わせが来る。

ご存じの通りAccessの郵便番号辞書は2013年で更新が止まっていて、
さらにAccess2010以降だと郵便番号辞書の形式が変わってしまっているのでどうしようもない。
(それ以前のバージョンであれば、某DLLを差し替えれば実は更新が可能だったりする)

そんなわけで今日も問い合わせが来たんだけど、なんか唐突に最新にする方法を閃いた。

住所入力支援を外したうえで、郵便番号の更新後処理をこんな感じにする

Private Sub TXT_郵便_AfterUpdate()
    If Trim(Nz(Me.TXT_住所)) = "" Then            
        Me.TXT_住所.SetFocus
        Me.TXT_住所 = Format(Me.TXT_郵便.Value, "000-0000")    
        VBA.Interaction.SendKeys "{CONVERT}"
        VBA.Interaction.SendKeys "{CONVERT}"
        VBA.Interaction.SendKeys "{CONVERT}"
        VBA.Interaction.SendKeys "{enter}"
    End If
End Sub

郵便番号部分を全部選択して、変換ボタンを3回ぐらい押せばWindows側のIMEにあるやつが出てくるってわけ。

うまく出てこなかったら最後のEnterだけ消せば、変換中の状態が表示されるし、もうそれで勘弁してくれという気持ち。

たまにnumlockがオフになるからそのときはこちらを参考に。
https://hatenachips.blog.fc2.com/blog-entry-400.html

MSZIP.DICをどうにかできないかと眺めてはみたけど、市町村名と町名が分かれて入ってるみたいで自力更新は難しそうなんだよな。
これ更新するならまだ郵便番号住所テーブルでも使ってdlookupする仕組みにする方が早いだろうし。




2023/7/5
numlock対策込みの改良版(※未テスト)*1

'Public Declare Function GetKeyboardState Lib "user32"    (pbKeyState As Byte) As Long	'32bitの場合はこちら
Public Declare PtrSafe Function GetKeyboardState Lib "user32"    (pbKeyState As Byte) As Long

Const VK_NUMLOCK = &H90

Function IsNumLockOn() As Boolean
    Dim keys(0 To 255) As Byte
    GetKeyboardState keys(0)
    IsNumLockOn = keys(VK_NUMLOCK)
End Function

Sub SendKeysWrapper(keys)
    Dim wasNumLock
    wasNumLock = IsNumLockOn()

    VBA.Interaction.SendKeys keys, True
    If wasNumLock = True Then
       VBA.Interaction.SendKeys "{NUMLOCK}", True
    End If
End Sub

'つかいかた
' Call Com_住所入力支援(Me, Me.txt_郵便, Me.txt_住所)
Public Sub Com_住所入力支援(D_Frm As Form, 郵便番号 As Object, 住所 As Object)
    If Trim(Nz(住所)) = "" Then
        D_Frm.SetFocus
        住所.SetFocus
        住所 = Format(郵便番号.value, "000-0000")
        SendKeysWrapper "{CONVERT}"
        SendKeysWrapper "{NONCONVERT}"
        SendKeysWrapper "{NONCONVERT}"
        SendKeysWrapper "{NONCONVERT}"
        SendKeysWrapper "{CONVERT}"
        SendKeysWrapper "{CONVERT}"

'候補が複数出ることがあるので最後のEnterはコメントしておく
'        SendKeysWrapper "{enter}"
     End If
End Sub

*1:テスト依頼してた新人が他部署に取られてそれ以降日の目を見ないままお蔵入りしてる