ユーザーフォームで郵便番号住所変換

MSの郵便番号変換ウィザードやIMEを使うのではなく独自に変換データベースを作成する方法をご紹介します。
サンプルをMDBACCDBの兼用版に変更しました。   従来は「MDB版」のみだったのですが、統合手段が見つかったので、各ツールを「MDB(ACCDB)版」という形に変更しました。
※シート上で「MDB」か「ACCDB」かを選択できます。(下記画面イメージは対応前のものです)
※今回は64ビット版Officeでの動作確認も行ないました。
※既にサポート切れとなって年数経過したOffice2007以前のバージョンには対応していません。



郵便番号→住所変換のサンプルブック
(この画像をクリックするとサンプルがダウンロードできます)

このサンプルの構成は、この画像のようなサンプルのExcelブック「郵便番号住所変換2.xlsm」だけですが、郵便番号住所変換データベース(KEN_ALL.mdb又はKEN_ALL.accdb)は、マクロから生成されるようになっています。

郵便番号住所変換データベース(KEN_ALL.mdb又はKEN_ALL.accdb)Accessで参照できるデータベースです。

作成済みのデータベースのテーブル

このテーブルの項目は、「ゆうびんホームページ」にある「郵便番号等のダウンロード」のページからダウンロードできる「郵便番号データファイル(全国一括:ken_all.zip)」を解凍してできる「KEN_ALL.CSV」のデータ形式に合わせてあります。
サンプルを利用される場合は、上記サイトより最新データをダウンロードさせた上で使用してみて下さい。
なお、このデータベース(KEN_ALL.mdb又はKEN_ALL.accdb)Excelのマクロ内で生成されて利用されるだけなので、このサンプルを利用する時点ではAccessがインストールされている必要はありません。

「郵便番号住所変換2.xlsm」を開くと、先頭の画像のようにシート上にボタンが2つ表示されます。
この内、上の「郵便番号データファイル(全国一括)の取り込み」は上記サイトからダウンロードさせて解凍したCSVファイル「KEN_ALL.CSV」を上記のデータベーステーブルに一括して取り込みます。


ボタンをクリックすると、まず「KEN_ALL.CSV」の所在を指定するダイアログが表示されます。

ファイルを開くダイアログ

ここで、解凍した「KEN_ALL.CSV」を指定して、「開く」をクリックすると処理が始まります。
件数が上記のような件数ですから、互換形式のExcelのシートに収まるものではありません。またインデックスを使った参照のレスポンスの良さもデータベースを使うメリットです。
処理中は、ステータスバーに処理件数が表示されていきますから、動作は確認できると思います。
処理が完了すると完了メッセージが表示されます。

郵便番号データを取り込んだところ

※上記画像の件数表示は「平成16年 9月 10日更新版」の状態です。

この取り込み処理のコードはこのようになっています。

'***************************************************************************************************
'   ADOでCSV形式ファイルからAccessデータベースを生成する
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   [参照設定]
'   ・Microsoft Scripting Runtime
'   ・Microsoft Active Data Object 2.x Library(2.8 or Later)
'   ・Microsoft Office 1x.0 Access database engine Object Library
'***************************************************************************************************
' 変更日付 Rev   変更履歴内容---------------------------------------------------------------------->
' 04/09/26(1.0.0)新規作成
' 06/06/05(1.1.0)データ型をadVarWCharに変更、コンパクト化
' 16/12/31(1.2.0)CSV側処理をFileSystemObjectに変更、全体最適化
' 19/12/01(1.3.0)64ビット版Office対応、ACCDB対応、MDB作成をDAOに変更
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsAdoConnectString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="""
Private Const g_cnsMdbName = "KEN_ALL.mdb"
Private Const g_cnsAccdbName = "KEN_ALL.accdb"
Private Const g_cnsDescription = "Description"

'***************************************************************************************************
'   ■■■ メイン処理 ■■■
'***************************************************************************************************
'* 処理名 :ImportKenAllCsv
'* 機能  :ADOで郵便番号データをINSERTさせる
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年09月26日
'* 作成者 :井上 治
'* 更新日 :2019年12月01日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:記述サンプルのためエラー処理は行なっていません
'***************************************************************************************************
Public Sub ImportKenAllCsv()
    '-----------------------------------------------------------------------------------------------
    Const cnsTitle = "CSV形式ファイルからテーブル登録"
    Dim xlAPP As Application                                        ' Excel.Application
    Dim WBK As Workbook                                             ' Excel.Workbook(本ブック)
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim objTs As TextStream                                         ' TextStream
    Dim dbCon As ADODB.Connection                                   ' ADODB.Connection
    Dim dbCmd As ADODB.Command                                      ' ADODB.Command
    Dim strConnect As String                                        ' MDB接続文字列
    Dim strFileName As String                                       ' OPENするファイル名(フルパス)
    Dim strMDBFileName As String                                    ' MDBファイル名(フルパス)
    Dim strSQL As String                                            ' SQL文
    Dim strSQL_Base As String                                       ' SQL文共通部
    Dim varFileName As Variant                                      ' ファイル名受け取りWORK
    Dim varX As Variant                                             ' 読み込んだレコード内容
    Dim lngREC As Long                                              ' レコード件数カウンタ
    Dim lngREC2 As Long                                             ' レコード件数表示用カウンタ
    Dim lngCol As Long                                              ' カラムINDEX

    Set xlAPP = Application
    Set WBK = ThisWorkbook
    '-----------------------------------------------------------------------------------------------
    ' 入力CSVファイルを指定する
    xlAPP.StatusBar = "読み込むCSVファイル名を指定して下さい。"
    varFileName = xlAPP.GetOpenFilename("CSV形式ファイル(*.csv),*.csv", , _
                                        "郵便番号データファイル(全国一括)を指定して下さい。")
    ' キャンセルされた場合は以降の処理は行なわない
    If VarType(varFileName) = vbBoolean Then Exit Sub
    strFileName = varFileName                                       ' CSVファイル名
    '-----------------------------------------------------------------------------------------------
    Set objFso = New FileSystemObject
    ' "KEN_ALL.mdb"or"KEN_ALL.accdb"のフルパス名編集
    If WBK.Worksheets(1).Cells(3, 8).Value <> "MDB" Then
        strMDBFileName = objFso.BuildPath(WBK.Path, g_cnsAccdbName)
    Else
        strMDBFileName = objFso.BuildPath(WBK.Path, g_cnsMdbName)
    End If
    ' "KEN_ALL.mdb"or"KEN_ALL.accdb"の生成
    If Not FP_MakeKenAllMdb(strMDBFileName) Then Exit Sub
    '-----------------------------------------------------------------------------------------------
    ' 指定CSVファイルをOPEN(入力モード)
    Set objTs = objFso.OpenTextFile(strFileName, ForReading)
    ' 接続を確立する(本ブックのフォルダにある"KEN_ALL.mdb"が対象)
    strConnect = g_cnsAdoConnectString & strMDBFileName & """;"
    Set dbCon = New ADODB.Connection
    dbCon.Open strConnect
    ' Commandの取得
    Set dbCmd = New ADODB.Command
    dbCmd.ActiveConnection = dbCon
    ' SQL文共通部の編集
    strSQL_Base = "INSERT INTO YUBIN (CODE1,ZIP_OLD,ZIPCODE,KEN_KANA,SHI_KANA,CHO_KANA"
    strSQL_Base = strSQL_Base & ",KEN_KANJI,SHI_KANJI,CHO_KANJI"
    strSQL_Base = strSQL_Base & ",FLG1,FLG2,FLG3,FLG4,FLG5,FLG6) VALUES ("
    ' 画面描画更新停止
    Call GP_StopSCUPD
    ' CSVファイルのEOF(End of File)まで繰り返す
    Do Until objTs.AtEndOfStream
        ' 処理中状況は1000件単位で表示
        xlAPP.StatusBar = "読み込み中です....(" & lngREC & "レコード目)"
        DoEvents
        lngREC2 = lngREC + 1000
        Do Until (objTs.AtEndOfStream Or (lngREC >= lngREC2))
            ' 件数カウンタの加算
            lngREC = lngREC + 1
            ' レコードを読み込んでカンマで分解
            varX = Split(objTs.ReadLine, ",")
            ' 文字列フィールドのダブルクォーテーション除去
            For lngCol = 1 To 8
                If Left(varX(lngCol), 1) = """" Then
                    varX(lngCol) = Trim(Mid(varX(lngCol), 2, Len(varX(lngCol)) - 2))
                End If
            Next lngCol
            ' MDBにINSERT(新規DBなので重複チェックなし)
            strSQL = strSQL_Base & varX(0)
            strSQL = strSQL & ",'" & varX(1) & "'"
            strSQL = strSQL & ",'" & varX(2) & "'"
            strSQL = strSQL & ",'" & varX(3) & "'"
            strSQL = strSQL & ",'" & varX(4) & "'"
            strSQL = strSQL & ",'" & varX(5) & "'"
            strSQL = strSQL & ",'" & varX(6) & "'"
            strSQL = strSQL & ",'" & varX(7) & "'"
            strSQL = strSQL & ",'" & varX(8) & "'"
            strSQL = strSQL & "," & varX(9)
            strSQL = strSQL & "," & varX(10)
            strSQL = strSQL & "," & varX(11)
            strSQL = strSQL & "," & varX(12)
            strSQL = strSQL & "," & varX(13)
            strSQL = strSQL & "," & varX(14) & ");"
            dbCmd.CommandText = strSQL
            dbCmd.Execute
        Loop
    Loop
    ' 指定ファイルをCLOSE
    objTs.Close
    xlAPP.StatusBar = False
    dbCon.Close
    Set dbCon = Nothing
    ' 画面描画更新復帰
    Call GP_StartSCUPD
    ' 終了の表示
    MsgBox "ファイル読み込みが完了しました。" & vbCr & _
        "レコード件数=" & lngREC & "件", vbInformation, cnsTitle
    WBK.Saved = True
End Sub

'***************************************************************************************************
'* 処理名 :ShowYubinForm
'* 機能  :郵便番号⇒住所変換フォームの表示
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年09月26日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub ShowYubinForm()
    FRM_ZIPCODE.Show
    Unload FRM_ZIPCODE
    Set FRM_ZIPCODE = Nothing
End Sub

'***************************************************************************************************
'   ■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名 :FP_MakeKenAllMdb
'* 機能  :郵便番号住所変換MDBファイルの生成
'---------------------------------------------------------------------------------------------------
'* 返り値 :処理成否(Boolean)
'* 引数  :Arg1 = ファイル名(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年09月26日
'* 作成者 :井上 治
'* 更新日 :2019年12月01日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Function FP_MakeKenAllMdb(ByVal strMDBFileName As String) As Boolean
    '-----------------------------------------------------------------------------------------------
    Const cnsTitle As String = "郵便番号住所変換MDBファイルの生成"
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim objMdb As DAO.Database                                      ' DAO.Database
    Dim objTbl As DAO.TableDef                                      ' DAO.TableDef
    Dim objIdx As DAO.Index                                         ' DAO.Index
    Dim blnOpen As Boolean                                          ' Open判定
    Dim strExtU As String                                           ' 拡張子(大文字)
    Dim strErrMSG As String                                         ' エラーメッセージ
    '-----------------------------------------------------------------------------------------------
    FP_MakeKenAllMdb = False
    On Error GoTo MakeKenAllMdb_ERR
    Set objFso = New FileSystemObject
    ' 当該MDB(ACCDB)が既に存在する場合は一旦、削除する
    If objFso.FileExists(strMDBFileName) Then
        ' 削除の確認
        If MsgBox("指定のデータベースファイルは既に存在しています。" & vbCr & _
                  "本生成処理を行なうと現データベースに登録されているデータは" & vbCr & _
                  "全て失われます。処理を行なってよろしいですか?", _
                  vbInformation + vbYesNo, cnsTitle) <> vbYes Then GoTo MakeKenAllMdb_EXIT
        ' 旧MDB(ACCDB)を削除
        Application.DisplayAlerts = False
        objFso.DeleteFile strMDBFileName, True
        Application.DisplayAlerts = True
    End If
    '-----------------------------------------------------------------------------------------------
    ' 拡張子の取得
    strExtU = UCase(objFso.GetExtensionName(strMDBFileName))
    ' MDB(ACCDB)を生成(拡張子を判定して種別を制御)
    If strExtU <> "ACCDB" Then
        ' MDBとして処理
        Set objMdb = DBEngine.CreateDatabase(strMDBFileName, dbLangJapanese, dbVersion40)
    Else
        ' ACCDBとして処理(デフォルト)
        Set objMdb = DBEngine.CreateDatabase(strMDBFileName, dbLangJapanese)
    End If
    blnOpen = True
    '-----------------------------------------------------------------------------------------------
    ' テーブルの作成
    Set objTbl = objMdb.CreateTableDef("YUBIN")
    '-----------------------------------------------------------------------------------------------
    ' フィールドを作成
    Call GP_AppendField(objTbl, "CODE1", dbLong, 7)         ' (00)全国地方公共団体コード
    Call GP_AppendField(objTbl, "ZIP_OLD", dbText, 5)       ' (01)旧郵便番号
    Call GP_AppendField(objTbl, "ZIPCODE", dbText, 7)       ' (02)郵便番号
    Call GP_AppendField(objTbl, "KEN_KANA", dbText, 50)     ' (03)都道府県名(カナ)
    Call GP_AppendField(objTbl, "SHI_KANA", dbText, 50)     ' (04)市区町村名(カナ)
    Call GP_AppendField(objTbl, "CHO_KANA", dbText, 100)    ' (05)町域名(カナ)
    Call GP_AppendField(objTbl, "KEN_KANJI", dbText, 50)    ' (06)都道府県名
    Call GP_AppendField(objTbl, "SHI_KANJI", dbText, 50)    ' (07)市区町村名
    Call GP_AppendField(objTbl, "CHO_KANJI", dbText, 100)   ' (08)町域名
    Call GP_AppendField(objTbl, "FLG1", dbInteger, 1)       ' (09)一町域が二以上の郵便番号
    Call GP_AppendField(objTbl, "FLG2", dbInteger, 1)       ' (10)小字毎に番地が起番されている
    Call GP_AppendField(objTbl, "FLG3", dbInteger, 1)       ' (11)丁目を有する町域
    Call GP_AppendField(objTbl, "FLG4", dbInteger, 1)       ' (12)一つの郵便番号で二以上の町域
    Call GP_AppendField(objTbl, "FLG5", dbInteger, 1)       ' (13)更新の表示
    Call GP_AppendField(objTbl, "FLG6", dbInteger, 1)       ' (14)変更理由
    '-----------------------------------------------------------------------------------------------
    ' INDEXの作成(Primaryキー無し)
    Set objIdx = objTbl.CreateIndex("Index_1")
    objIdx.Primary = False
    objIdx.Unique = False
    objIdx.Fields.Append objIdx.CreateField("ZIPCODE")
    objTbl.Indexes.Append objIdx        ' INDEXを追加
    '-----------------------------------------------------------------------------------------------
    ' MDB(ACCDB)にテーブルを追加
    objMdb.TableDefs.Append objTbl
    ' 一旦閉じる
    objMdb.Close
    blnOpen = False
    DoEvents
    '-----------------------------------------------------------------------------------------------
    ' 通常のOPEN
    Set objMdb = DBEngine.OpenDatabase(strMDBFileName)
    blnOpen = True
    Set objTbl = objMdb.TableDefs("YUBIN")
    ' コメント(Description)のセット
    Call GP_AppendComment(objTbl, "CODE1", "全国地方公共団体コード")    ' (00)全国地方公共団体コード
    Call GP_AppendComment(objTbl, "ZIP_OLD", "旧郵便番号")              ' (01)旧郵便番号
    Call GP_AppendComment(objTbl, "ZIPCODE", "郵便番号")                ' (02)郵便番号
    Call GP_AppendComment(objTbl, "KEN_KANA", "都道府県名(カナ)")       ' (03)都道府県名(カナ)
    Call GP_AppendComment(objTbl, "SHI_KANA", "市区町村名(カナ)")       ' (04)市区町村名(カナ)
    Call GP_AppendComment(objTbl, "CHO_KANA", "町域名(カナ)")           ' (05)町域名(カナ)
    Call GP_AppendComment(objTbl, "KEN_KANJI", "都道府県名")            ' (06)都道府県名
    Call GP_AppendComment(objTbl, "SHI_KANJI", "市区町村名")            ' (07)市区町村名
    Call GP_AppendComment(objTbl, "CHO_KANJI", "町域名")                ' (08)町域名
    Call GP_AppendComment(objTbl, "FLG1", "一町域が二以上の郵便番号")   ' (09)一町域が二以上の郵便番号
    Call GP_AppendComment(objTbl, "FLG2", "小字毎に番地が起番されている") ' (10)小字毎に番地が起番されている
    Call GP_AppendComment(objTbl, "FLG3", "丁目を有する町域")           ' (11)丁目を有する町域
    Call GP_AppendComment(objTbl, "FLG4", "一つの郵便番号で二以上の町域") ' (12)一つの郵便番号で二以上の町域
    Call GP_AppendComment(objTbl, "FLG5", "更新の表示")                 ' (13)更新の表示
    Call GP_AppendComment(objTbl, "FLG6", "変更理由")                   ' (14)変更理由
    FP_MakeKenAllMdb = True
    GoTo MakeKenAllMdb_EXIT

'===================================================================================================
' エラー処理
MakeKenAllMdb_ERR:
    strErrMSG = Err.Number & " " & Err.Description

'===================================================================================================
' 終了
MakeKenAllMdb_EXIT:
    ' MDB(ACCDB)を切断
    If blnOpen Then objMdb.Close
    Set objMdb = Nothing
    ' エラーがあるか
    If strErrMSG <> "" Then
        MsgBox strErrMSG, vbCritical, cnsTitle
    End If
    Set objFso = Nothing
    On Error GoTo 0
End Function

'***************************************************************************************************
'* 処理名 :GP_AppendField
'* 機能  :テーブルにフィールドを追加(サブ処理)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = テーブル(DAO.TableDef)
'*      Arg2 = フィールドID(String)
'*      Arg3 = データタイプ(DataTypeEnum)
'*      Arg4 = サイズ(Integer)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2019年12月01日
'* 作成者 :井上 治
'* 更新日 :2019年12月01日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_AppendField(ByRef objTbl As DAO.TableDef, _
                           ByVal strFieldId As String, _
                           ByVal intDataType As DataTypeEnum, _
                           ByVal intSyze As Integer)
    '-----------------------------------------------------------------------------------------------
    Dim objFld As DAO.Field                                         ' DAO.Field
    Set objFld = objTbl.CreateField(strFieldId, intDataType, intSyze)
    ' フィールドを追加
    objTbl.Fields.Append objFld
    Set objFld = Nothing
End Sub

'***************************************************************************************************
'* 処理名 :GP_AppendComment
'* 機能  :フィールドにコメント(Description)を追加(サブ処理)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = テーブル(DAO.TableDef)
'*      Arg2 = フィールドID(String)
'*      Arg3 = コメント(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2019年12月01日
'* 作成者 :井上 治
'* 更新日 :2019年12月01日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_AppendComment(ByRef objTbl As DAO.TableDef, _
                             ByVal strFieldId As String, _
                             ByVal strComment As String)
    '-----------------------------------------------------------------------------------------------
    Dim objFld As DAO.Field                                         ' DAO.Field
    Dim objPpt As DAO.Property                                      ' DAO.Property
    Set objFld = objTbl.Fields(strFieldId)
    Set objPpt = objFld.CreateProperty(g_cnsDescription, dbText, strComment)
    objFld.Properties.Append objPpt
    Set objPpt = Nothing
    Set objFld = Nothing
End Sub

'------------------------------------------<< End of Source >>--------------------------------------
ここではインポートさせるユーティリティやデータベースに依存するステートメントは使わず、もっとも単純な(?) SQLINSERT文を使うことにしましたから、他用途に転用して使うことも可能だと思います。
テーブル作成でのデータ型については、データベースによって利用可否や制限があります。このサンプルはあくまでAccess(*.mdb)で利用できる記述ということになります。

さて、ここからが本題です。
最初のシートの下の「郵便番号→住所変換のサンプル」をクリックすると、このようなサンプルフォームが表示されます。

郵便番号から住所変換のサンプルフォーム

サンプルですから、あまり込み入ったことはしないようにしています。

ここで郵便番号を入力してみると、

郵便番号を入力したところ

このように住所が自動表示されます。

サンプルですから、解りやすいように全てをフォームのモジュール上に書いています。

'***************************************************************************************************
'   郵便番号から住所を自動入力するサンプル
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   [参照設定]
'   ・Microsoft Active Data Object 2.x Library(2.8 or Later)
'***************************************************************************************************
' 変更日付 Rev   変更履歴内容---------------------------------------------------------------------->
' 04/09/26(1.0.0)新規作成
' 06/06/05(1.1.0)データ型をadVarWCharに変更、コンパクト化
' 16/12/31(1.2.0)CSV側処理をFileSystemObjectに変更、全体最適化
' 19/12/01(1.3.0)64ビット版Office対応、ACCDB対応
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsAdoConnectString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="""
Private Const g_cnsMdbName = "KEN_ALL.mdb"
Private Const g_cnsAccdbName = "KEN_ALL.accdb"
Private g_strConnect As String                                      ' MDB接続文字列
Private g_swLetClose As Boolean                                     ' Close判定

'***************************************************************************************************
'   ■■■ コントロールイベント ■■■
'***************************************************************************************************
'* 処理名 :TXT_ZIPCODE_Exit
'* 機能  :郵便番号テキストボックスイベント(Exit)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年09月26日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub TXT_ZIPCODE_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    '-----------------------------------------------------------------------------------------------
    Dim dbCon As ADODB.Connection                                   ' ADODB.Connection
    Dim dbRes As ADODB.Recordset                                    ' ADODB.Recordset
    Dim strSQL As String                                            ' SQL文
    Dim strZipCode As String                                        ' 郵便番号
    ' 閉じる時に本イベントが発生するのを回避
    If g_swLetClose Then Exit Sub
    ' フォーム入力内容チェック
    If Not FP_CheckForm(strZipCode, Cancel) Then Exit Sub
    '-----------------------------------------------------------------------------------------------
    ' 接続を確立する(本ブックのフォルダにある"KEN_ALL.mdb"が対象)
    Set dbCon = New ADODB.Connection
    dbCon.Open g_strConnect
    ' テーブル名,条件を指定してレコードセットを取得する
    strSQL = "SELECT KEN_KANJI,SHI_KANJI,CHO_KANJI FROM YUBIN WHERE ZIPCODE='" & strZipCode & "';"
    Set dbRes = New ADODB.Recordset
    dbRes.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly
    If Not dbRes.EOF Then
        ' レコード発見時は住所をセット
        TXT_JUSYO.Text = dbRes.Fields("KEN_KANJI").Value & _
                         dbRes.Fields("SHI_KANJI").Value & _
                         dbRes.Fields("CHO_KANJI").Value
    Else
        TXT_JUSYO.Text = "?????"
    End If
    dbRes.Close
    Set dbRes = Nothing
    dbCon.Close
    Set dbCon = Nothing
End Sub

'***************************************************************************************************
'   ■■■ フォームイベント ■■■
'***************************************************************************************************
'* 処理名 :UserForm_Initialize
'* 機能  :フォーム初期化
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年09月26日
'* 作成者 :井上 治
'* 更新日 :2019年12月01日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub UserForm_Initialize()
    '-----------------------------------------------------------------------------------------------
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim WBK As Workbook                                             ' Excel.Workbook(本ブック)
    Dim strExtU As String                                           ' 拡張子(大文字)
    Dim strMDBFileName As String                                    ' MDBファイル名(フルパス)
    With Me
        .TXT_ZIPCODE.Text = ""
        .TXT_JUSYO.Text = ""
    End With
    Set WBK = ThisWorkbook
    Set objFso = New FileSystemObject
    ' "KEN_ALL.mdb"or"KEN_ALL.accdb"のフルパス名編集
    If WBK.Worksheets(1).Cells(3, 8).Value <> "MDB" Then
        strMDBFileName = objFso.BuildPath(WBK.Path, g_cnsAccdbName)
    Else
        strMDBFileName = objFso.BuildPath(WBK.Path, g_cnsMdbName)
    End If
    Set objFso = Nothing
    ' 接続文字列の編集
    g_strConnect = g_cnsAdoConnectString & strMDBFileName & """;"
    g_swLetClose = False
End Sub

'***************************************************************************************************
'* 処理名 :UserForm_QueryClose
'* 機能  :フォーム閉鎖動作
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2004年09月26日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    '-----------------------------------------------------------------------------------------------
    ' 閉じる[×]ボタンがクリックされたらスイッチをセット
    If CloseMode = vbFormControlMenu Then g_swLetClose = True
End Sub

'***************************************************************************************************
'   ■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名 :FP_CheckForm
'* 機能  :フォーム入力内容チェック
'---------------------------------------------------------------------------------------------------
'* 返り値 :チェック成否
'* 引数  :Arg1 = 郵便番号(String)
'*      Arg2 = キャンセル(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Function FP_CheckForm(ByRef strZipCode As String, _
                              ByRef Cancel As MSForms.ReturnBoolean) As Boolean
    '-----------------------------------------------------------------------------------------------
    FP_CheckForm = False
    ' ハイフンを除いた郵便番号を編集
    strZipCode = Replace(Trim(TXT_ZIPCODE.Text), "-", "")
    ' 内容チェック
    If IsNumeric(strZipCode) <> True Then
        MsgBox "郵便番号が数字ではありません。", vbExclamation
        Cancel = True
        Exit Function
    ElseIf Len(strZipCode) <> 7 Then
        MsgBox "郵便番号が7桁ではありません。", vbExclamation
        Cancel = True
        Exit Function
    End If
    FP_CheckForm = True
End Function

'------------------------------------------<< End of Source >>--------------------------------------
郵便番号から住所への変換自体は、郵便番号のテキストボックス(TXT_ZIPCODE)のExitイベントで処理してみました。一応、ハイフンを除いた状態で入力内容のチェックを行なった上で、YUBINテーブルを参照し、レコードがあったら「都道府県名」「市区町村名」「町域名」を接合して、住所のテキストボックス(TXT_JUSYO)に転記させています。

実用化させる上での問題としては、Exitイベントを使っていることから、一旦住所の登録が完了していても、郵便番号の項目にカーソルが入ってしまうと、そこから抜けた場合に再度Exitイベントが発生して、データベースから読み出した住所に戻ってしまうことがあります。既に住所が入力されていたら、再処理させないように記述すれば、この点は避けられるでしょう。

あと、郵便番号データファイルのデータ上の問題として、下記のようなことがあります。

○一部で同一郵便番号のデータが複数登録されている。

1つの郵便番号が複数の町域を受け持ち、しかもそれが複数レコードに登録されている例


○「町域名」に「以下に掲載がない場合」という語句が入っていることがある。

町域に「以下に掲載がない場合」と記載されている


実務に利用する場合には、このような例外事項を考慮する必要があるでしょう。
厳密に考えると、同一郵便番号が複数発生する場合はプルダウンリストから選択できるようにするなどの配慮が必要で、そのためにはデータベース(*.mdb)への格納時に上記のカッコで複数町域を表示するような方法は別個のレコードになるように編集しておくと良いでしょう。
また、割り切った考え方として、元々住所入力の補助なのだからということで、重複が問題にならないところまでを表示するようにしてしまう(削ってしまう)方法もあります。

このページではVBAコードの理解を進めていただくために、サンプルとしてはあまり複雑にしたくないこともあるのでこのようなことへの配慮はしておりません。
自分で独自に組み込むのでは難しいと考えられている方には、フリーソフトでアドインツールが出されているので、それを利用する方法もあります。
参考サイト : AddinBox(kt電話郵便アドイン)