[VBA]日本の都道府県名、地方公共団体名を抜き出す 3 総務省の地方公共団体コードからテーブルを作る

#前回までの流れ
[VBA]日本の都道府県名、地方公共団体名を抜き出す
からさらにAccess用に
[VBA]日本の都道府県名、地方公共団体名を抜き出す ２ 郵便番号簿マスターをテーブルにする
で郵便番号簿をACCessのテーブルにしました。
次は総務省の地方公共団体コードです。
H28.10現在の地方公共団体コードはxls形式で2枚のシートになっています。
このシートから
都道府県コードのテーブル
市区町村のテーブル
東京都23区以外の政令都市の区のコードのテーブル。ただし政令指定都市と紐付けること。
という3つのテーブルを一気に作ります。
Providerが12なので、現在のところAccess2010からはそのまま使えます。
それ以前の場合はJetに変える必要があります。

#下準備
総務省のホームページからxls形式のデータをダウンロードします。
これをExcel2007以降で開いて
都道府県コード及び市区町村コード.xlsx
という名前でDドライブルート直下に置いたとしてコードを書いています。
D:\都道府県コード及び市区町村コード.xlsx
#ポイントとコード

#ポイント

• Create Tableでテーブルを作るときに主キーを最初から追加している
• Excelに複数のシートがある場合の接続文字列の書き方
• なぜか不具合が連発したのでXlsxに変えてProviderを12にしている。
• きたきゅうしゅうし、ひろしまし、しずおかしのよみが「し」で切れないので、前２つをリプレイス、しずおかしはInstrを2文字目からカウントすることで回避
• 政令指定都市は[VBA]日本の都道府県名、地方公共団体名を抜き出すで紹介したように東京都23区は含まれていない。東京都23区は市として扱われているため。
• 地方公共団体の読みをテーブル間で共通にするため、地方公共団体の読みは半角カナとしたが、最後の区だけひらがなにしている。
• 作ったテーブルから早速罠の多いDlookUp(ACCESS VBA DLOOKUP関数覚書 マイクロソフト公式が教えてくれない罠)で半角カナを引用。

##コード
Access2010Later用である。

ImportLocalGovCode

Sub ImportLocalGovCode()
'Access 2010 Later
Dim cdb As DAO.Database: Set cdb = CurrentDb
Dim Q As QueryDef
Dim T As TableDef
Dim rs As DAO.Recordset
Dim adRS As ADODB.Recordset
Dim CN As ADODB.Connection: Set CN = New ADODB.Connection
Dim fld As DAO.Field
Dim i As Long, iAr As Long, iaAr As Long, buf As String, str As String, sSQL As String, iCNT As Long
Dim irow As Long, icol As Long
Const FN = "D:\都道府県コード及び市区町村コード.xlsx" 'xlsだとうまくいかない。インストール可能なISAMドライバが見つかりませんでした。エラーが出る。なぜかxlsxだと回避できる。
Const SN = "H28.10.10現在の団体" 'H28.10.10現在のデータのシート名のため、データが更新されたら変わる。別のシートも同じ
For Each T In cdb.TableDefs
If T.Name = "T_JPLocalGovCode" Then DoCmd.DeleteObject acTable, "T_JPLocalGovCode"
If T.Name = "T_JpDesinatedCityCode" Then DoCmd.DeleteObject acTable, "T_JpDesinatedCityCode"
If T.Name = "T_JpPrefectureCode" Then DoCmd.DeleteObject acTable, "T_JpPrefectureCode"
Next
sSQL = "CREATE TABLE T_JPLocalGovCode(F00ID COUNTER PRIMARY KEY,F01団体コード TEXT(50),F02都道府県名 TEXT(50),F03市区町村名 TEXT(50),F04都道府県名ヨミ TEXT(50),F05市区町村名ヨミ TEXT(50));"
DoCmd.RunSQL sSQL
sSQL = "Create Table T_JpDesinatedCityCode(F00ID COUNTER,F01団体コード TEXT(50),F02政令都市名 TEXT(50),F03区コード text(50),F04区名 TEXT(50),F04都市名ヨミ TEXT(50),F05市区名ヨミ Text(50));"
DoCmd.RunSQL sSQL
sSQL = "Create Table T_JpPrefectureCode(F00ID COUNTER,F01都道府県コード TEXT(50),F02都道府県名 TEXT(50),F03都道府県名よみ TEXT(50));"
DoCmd.RunSQL sSQL
Access.Application.RefreshDatabaseWindow
CN.Open ("Provider = Microsoft.ACE.OLEDB.12.0;Data Source=""D:\都道府県コード及び市区町村コード.xlsx"";Extended Properties=Excel 12.0 Xml")
Set adRS = New ADODB.Recordset
Set rs = cdb.OpenRecordset("T_JPLocalGovCode", dbOpenDynaset)
adRS.Open "Select * From [" & SN & "$];", CN, adOpenDynamic, adLockReadOnly
adRS.MoveFirst
Do While adRS.EOF = False
If adRS(2).Value <> "" Then
rs.AddNew
rs.Fields(1) = adRS(0)
rs.Fields(2) = adRS(1)
rs.Fields(3) = adRS(2)
rs.Fields(4) = adRS(3)
rs.Fields(5) = adRS(4)
rs.Update
End If
adRS.MoveNext
Loop
rs.Close
Set rs = cdb.OpenRecordset("T_JpPrefectureCode", dbOpenDynaset)
adRS.MoveFirst
Do While adRS.EOF = False
If IsNull(adRS(2).Value) = True Then
rs.AddNew
rs.Fields(1) = adRS(0)
rs.Fields(2) = adRS(1)
rs.Fields(3) = adRS(3)
rs.Update
End If
adRS.MoveNext
Loop
adRS.Close
adRS.Open "Select * From [" & "H28.10.10政令指定都市" & "$];", CN, adOpenDynamic, adLockReadOnly
adRS.MoveFirst
Set rs = cdb.OpenRecordset("T_JpDesinatedCityCode", dbOpenDynaset)
Do While adRS.EOF = False
buf = adRS(1)
iCNT = InStr(1, buf, "区")

If iCNT <> 0 Then
rs.AddNew

rs.Fields("F01団体コード") = DLookup("[F01団体コード]", "T_JPLocalGovCode", "[F03市区町村名] = " & "'" & Mid(adRS(1), 1, InStr(1, adRS(1), "市", vbTextCompare)) & "'" & "")
rs.Fields("F02政令都市名") = Mid(adRS(1), 1, InStr(1, adRS(1), "市", vbTextCompare))

rs.Fields("F04区名") = Mid(adRS(1), InStr(1, adRS(1), "市", vbTextCompare) + 1, Len(adRS(1)))
rs.Fields("F03区コード") = adRS(0)
rs.Fields("F04都市名ヨミ") = DLookup("[F05市区町村名ヨミ]", "T_JPLocalGovCode", "[F03市区町村名] = " & "'" & Mid(adRS(1), 1, InStr(1, adRS(1), "市", vbTextCompare)) & "'" & "")

str = Replace(Replace(adRS(2), "きたきゅうしゅう", "", 1, 1, vbTextCompare) _
, "ひろしま", "", 1, 1, vbTextCompare) 'しが先に来るひろしま、きたきゅうしゅうを除外,しずおかはInstrを2文字目からスタートで回避

rs.Fields("F05市区名ヨミ") = Mid(str, 1 + InStr(2, str, "し", vbTextCompare), Len(adRS(2)))

rs.Update
End If
adRS.MoveNext
Loop
End Sub

#いちおうこのシリーズで
[VBA]日本の都道府県名、地方公共団体名を抜き出す
[VBA]日本の都道府県名、地方公共団体名を抜き出す ２ 郵便番号簿マスターをテーブルにする
それと今回で地方自治体のコード、郵便番号がいつでもスムーズにテーブルとして使えるます。また、住所から地方自治体名を抜き出すことが関数を定義することで可能になりました。
これでかなりAccessで住所を扱うことが楽になると思います。

たとえば市町村の最大文字数を数えたい場合、上記のVBAでテーブルをつくり、次のVBAでクエリを作ります

Sub ImportLocalGovCode()
'Access 2010 Later
Dim cdb As DAO.Database: Set cdb = CurrentDb
Dim Q As QueryDef
Dim T As TableDef
Dim rs As DAO.Recordset
Dim adRS As ADODB.Recordset
Dim CN As ADODB.Connection: Set CN = New ADODB.Connection
Dim fld As DAO.Field
Dim i As Long, iAr As Long, iaAr As Long, buf As String, str As String, sSQL As String, iCNT As Long
Dim irow As Long, icol As Long
Const FN = "D:\都道府県コード及び市区町村コード.xlsx" 'xlsだとうまくいかない。インストール可能なISAMドライバが見つかりませんでした。エラーが出る。なぜかxlsxだと回避できる。
Const SN = "H28.10.10現在の団体" 'H28.10.10現在のデータのシート名のため、データが更新されたら変わる。別のシートも同じ
For Each T In cdb.TableDefs
If T.Name = "T_JPLocalGovCode" Then DoCmd.DeleteObject acTable, "T_JPLocalGovCode"
If T.Name = "T_JpDesinatedCityCode" Then DoCmd.DeleteObject acTable, "T_JpDesinatedCityCode"
If T.Name = "T_JpPrefectureCode" Then DoCmd.DeleteObject acTable, "T_JpPrefectureCode"
Next
sSQL = "CREATE TABLE T_JPLocalGovCode(F00ID COUNTER PRIMARY KEY,F01団体コード TEXT(50),F02都道府県名 TEXT(50),F03市区町村名 TEXT(50),F04都道府県名ヨミ TEXT(50),F05市区町村名ヨミ TEXT(50));"
DoCmd.RunSQL sSQL
sSQL = "Create Table T_JpDesinatedCityCode(F00ID COUNTER,F01団体コード TEXT(50),F02政令都市名 TEXT(50),F03区コード text(50),F04区名 TEXT(50),F04都市名ヨミ TEXT(50),F05市区名ヨミ Text(50));"
DoCmd.RunSQL sSQL
sSQL = "Create Table T_JpPrefectureCode(F00ID COUNTER,F01都道府県コード TEXT(50),F02都道府県名 TEXT(50),F03都道府県名よみ TEXT(50));"
DoCmd.RunSQL sSQL
Access.Application.RefreshDatabaseWindow
CN.Open ("Provider = Microsoft.ACE.OLEDB.12.0;Data Source=""D:\都道府県コード及び市区町村コード.xlsx"";Extended Properties=Excel 12.0 Xml")
Set adRS = New ADODB.Recordset
Set rs = cdb.OpenRecordset("T_JPLocalGovCode", dbOpenDynaset)
adRS.Open "Select * From [" & SN & "$];", CN, adOpenDynamic, adLockReadOnly
adRS.MoveFirst
Do While adRS.EOF = False
If adRS(2).Value <> "" Then
rs.AddNew
rs.Fields(1) = adRS(0)
rs.Fields(2) = adRS(1)
rs.Fields(3) = adRS(2)
rs.Fields(4) = adRS(3)
rs.Fields(5) = adRS(4)
rs.Update
End If
adRS.MoveNext
Loop
rs.Close
Set rs = cdb.OpenRecordset("T_JpPrefectureCode", dbOpenDynaset)
adRS.MoveFirst
Do While adRS.EOF = False
If IsNull(adRS(2).Value) = True Then
rs.AddNew
rs.Fields(1) = adRS(0)
rs.Fields(2) = adRS(1)
rs.Fields(3) = adRS(3)
rs.Update
End If
adRS.MoveNext
Loop
adRS.Close
adRS.Open "Select * From [" & "H28.10.10政令指定都市" & "$];", CN, adOpenDynamic, adLockReadOnly
adRS.MoveFirst
Set rs = cdb.OpenRecordset("T_JpDesinatedCityCode", dbOpenDynaset)
Do While adRS.EOF = False
buf = adRS(1)
iCNT = InStr(1, buf, "区")
If iCNT <> 0 Then
rs.AddNew
rs.Fields("F01団体コード") = DLookup("[F01団体コード]", "T_JPLocalGovCode", "[F03市区町村名] = " & "'" & Mid(adRS(1), 1, InStr(1, adRS(1), "市", vbTextCompare)) & "'" & "")
rs.Fields("F02政令都市名") = Mid(adRS(1), 1, InStr(1, adRS(1), "市", vbTextCompare))
rs.Fields("F04区名") = Mid(adRS(1), InStr(1, adRS(1), "市", vbTextCompare) + 1, Len(adRS(1)))
rs.Fields("F03区コード") = adRS(0)
rs.Fields("F04都市名ヨミ") = DLookup("[F05市区町村名ヨミ]", "T_JPLocalGovCode", "[F03市区町村名] = " & "'" & Mid(adRS(1), 1, InStr(1, adRS(1), "市", vbTextCompare)) & "'" & "")
str = Replace(Replace(adRS(2), "きたきゅうしゅう", "", 1, 1, vbTextCompare) _
, "ひろしま", "", 1, 1, vbTextCompare) 'しが先に来るひろしま、きたきゅうしゅうを除外,しずおかはInstrを2文字目からスタートで回避
rs.Fields("F05市区名ヨミ") = Mid(str, 1 + InStr(2, str, "し", vbTextCompare), Len(adRS(2)))
rs.Update
End If
adRS.MoveNext
Loop
End Sub