Microsoftの郵便番号変換ウィザードやIMEを使うのではなく独自に変換データベースを作成する方法をご紹介します。
(この画像をクリックするとサンプルがダウンロードできます)
このサンプルの構成は、この画像のようなサンプルの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」を開くと、先頭の画像のようにシート上にボタンが２つ表示されます。
この内、上の「郵便番号データファイル(全国一括)の取り込み」は上記サイトからダウンロードさせて解凍したCSVファイル「KEN_ALL.CSV」を上記のデータベーステーブルに一括して取り込みます。
ボタンをクリックすると、まず「KEN_ALL.CSV」の所在を指定するダイアログが表示されます。
ここで、解凍した「KEN_ALL.CSV」を指定して、「開く」をクリックすると処理が始まります。
件数が上記のような件数ですから、互換形式のExcelのシートに収まるものではありません。またインデックスを使った参照のレスポンスの良さもデータベースを使うメリットです。
処理中は、ステータスバーに処理件数が表示されていきますから、動作は確認できると思います。
処理が完了すると完了メッセージが表示されます。
※上記画像の件数表示は「平成16年9月10日更新版」の状態です。
この取り込み処理のコードはこのようになっています。
'***************************************************************************************************
' ADOでCSV形式ファイルからAccessデータベースを生成する
'
' 作成者:井上治 URL:https://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 >>--------------------------------------
テーブル作成でのデータ型については、データベースによって利用可否や制限があります。このサンプルはあくまでAccess(*.mdb)で利用できる記述ということになります。
さて、ここからが本題です。
最初のシートの下の「郵便番号→住所変換のサンプル」をクリックすると、このようなサンプルフォームが表示されます。
サンプルですから、あまり込み入ったことはしないようにしています。
ここで郵便番号を入力してみると、
このように住所が自動表示されます。
サンプルですから、解りやすいように全てをフォームのモジュール上に書いています。
'***************************************************************************************************
' 郵便番号から住所を自動入力するサンプル
'
' 作成者:井上治 URL:https://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 "郵便番号が７桁ではありません。", vbExclamation
Cancel = True
Exit Function
End If
FP_CheckForm = True
End Function
'------------------------------------------<< End of Source >>--------------------------------------
実用化させる上での問題としては、Exitイベントを使っていることから、一旦住所の登録が完了していても、郵便番号の項目にカーソルが入ってしまうと、そこから抜けた場合に再度Exitイベントが発生して、データベースから読み出した住所に戻ってしまうことがあります。既に住所が入力されていたら、再処理させないように記述すれば、この点は避けられるでしょう。
あと、郵便番号データファイルのデータ上の問題として、下記のようなことがあります。
○一部で同一郵便番号のデータが複数登録されている。
○「町域名」に「以下に掲載がない場合」という語句が入っていることがある。
実務に利用する場合には、このような例外事項を考慮する必要があるでしょう。
厳密に考えると、同一郵便番号が複数発生する場合はプルダウンリストから選択できるようにするなどの配慮が必要で、そのためにはデータベース(*.mdb)への格納時に上記のカッコで複数町域を表示するような方法は別個のレコードになるように編集しておくと良いでしょう。
また、割り切った考え方として、元々住所入力の補助なのだからということで、重複が問題にならないところまでを表示するようにしてしまう(削ってしまう)方法もあります。
このページではVBAコードの理解を進めていただくために、サンプルとしてはあまり複雑にしたくないこともあるのでこのようなことへの配慮はしておりません。
自分で独自に組み込むのでは難しいと考えられている方には、フリーソフトでアドインツールが出されているので、それを利用する方法もあります。
参考サイト : AddinBox(kt電話郵便アドイン)