[VBA]日本の都道府県名、地方公共団体名を抜き出す ２ 郵便番号簿マスターをテーブルにする

ADODBでCSVを読む

前回の郵便局のCSVファイルをテーブルにします。
KEN_ALL_ROME.Csvがダウンロードフォルダにある場合です。
T_PostalCodeJPを作成します。
FilesystemObject,iwshRuntimeLibrary,Adodb.streamを参照設定してください。
本当はShift-JisなのでべつにAdodbで読まなくてもいいです。
というかShift-Jis じゃ な い のでびっくりしました。
コードをUtf-8にすると文字化けしてしまいます。
今回はUTF-8形式のテキストファイルから読み込む OfficeTanakaのメソッドに従い、全文を読み込んでから、改行で切り、さらにそれをコンマできっています。

#参照設定
ADODB

Sub Make_PostalCodeJpTable()
Dim cDB As DAO.Database: Set cDB = CurrentDb
Dim tdf As TableDef
Dim fld As DAO.Field
Dim tName As String, sFileName As String, sSQL As String, buf As String
Dim rs As DAO.Recordset
Dim i As Long, iar As Long, iaar As Long
Dim ar, aAr
Dim sr As ADODB.Stream: Set sr = New ADODB.Stream
Dim fs As Scripting.FileSystemObject: Set fs = New Scripting.FileSystemObject
Dim wsh As New IWshRuntimeLibrary.WshShell
sFileName = wsh.ExpandEnvironmentStrings("%USERPROFILE%") & "\Downloads\KEN_ALL_ROME.CSV"
If fs.FileExists(sFileName) = False Then Exit Sub
tName = "T_PoltalCodeJp"
For Each tdf In CurrentDb.TableDefs
If tdf.Name = tName Then DoCmd.SetWarnings False: DoCmd.DeleteObject acTable, tName: DoCmd.SetWarnings True: Exit Sub
Next
sSQL = "CREATE TABLE T_PoltalCodeJp(F00PostalID Counter Primary Key,F01郵便番号 Text(50),F02都道府県名 Text(50),F03市区郡名 Text(50),F04町村名 text(50),F05詳細 Text(50),F06Pref Text(100),F06City text(100),F07Detail Text(100));"
DoCmd.RunSQL sSQL
cDB.TableDefs.Refresh
Set rs = cDB.OpenRecordset(tName, dbOpenDynaset)
sr.Mode = adModeReadWrite
sr.Type = adTypeText
sr.Charset = "Shift-Jis"
sr.LineSeparator = adCRLF
sr.Open
sr.LoadFromFile "C:\Users\very_\Downloads\KEN_ALL_ROME.CSV"
buf = sr.ReadText
aAr = Split(buf, vbCrLf)
For iaar = LBound(aAr) To UBound(aAr) - 1
ar = Split(Replace(aAr(iaar), Chr(34), "", 1, -1, vbTextCompare), ",")

rs.AddNew
rs.Fields(1).Value = CStr(ar(0))
rs.Fields(2).Value = ar(1)
i = InStr(1, ar(2), "　", vbTextCompare)

If i > 1 Then
rs.Fields(3).Value = Mid(ar(2), 1, i - 1)
rs.Fields(4).Value = Mid(ar(2), i + 1, Len(ar(2)))
Else
rs.Fields(3).Value = ar(2)
End If
rs.Fields(5) = ar(4)
rs.Fields(6) = ar(5)
rs.Fields(7) = ar(6)
rs.Update
Next
sr.Close
rs.Close
End Sub

#このテーブルは
[VBA]日本の都道府県名、地方公共団体名を抜き出すで使ったデータから作っています。

#Ken_All.CSVは悪名が高すぎ
郵便番号データの落とし穴 作成日 2005/11/24 更新日 2010/10/02(Webarchive)

1. Shift-JIS でのみ提供されており、未定義の漢字はひらがなで表記されている
2. 町域名のフリガナが76文字を越える場合には、複数レコードに分割している。(複数レコード分割問題)
3. 並び順に法則性がない。
4. 一円、カッコガキ、意味不明な範囲の表現
5. 過去の経緯から？複数レコードに分割する必要がないにもかかわらず、なぜか分割されているものがある
6. 市町村はおろか県をまたがるものがある
7. 福島原発が爆発した影響がある
8. ken_all.csv を利用するには、事前にマージ処理を行う必要がある。
9. 検索時には、同一郵便番号に対して複数の町域が存在する場合の対応を決めておく。

##以下の参考リンクを見ると13年以上変わっていない
郵便会社提供の ken_all.csv がひどい件について。 プログラム 開発 等々 備忘録
郵便番号から住所を検索するサービスにまともなものがない - ぐるぐる? 2008/05/31
郵便番号データは自分で加工しない daily dayflower 2010/09/29
郵便番号データの悪夢 屑プログラマの憂鬱 2010/10/17
zipdoudの推奨
ろっきー氏のmy-hobbyのZIPNAVI関連記事リンクまとめページ2009-2010
FizzBuzz 問題どや顔で解くひとなんかよりも "KEN_ALL.csv" をうまく扱える人の方が社会的貢献度高い -Togetter 2012/8/8
KEN_ALL.CSV (郵便番号検索)の落とし穴 by nanasess - QITA 2016/07/14更新
国土地理協会の紹介、Githubのパーサーの紹介あり
2016年現在の問題点。あまり変わらない。
郵便番号や市区町村データを取り扱うときにはまったこと - QITA 2017/4/21更新
市区町村はおろか、県をまたがるものがあること
KEN_ALL.csv のどこがだめなのかまとめてみる 最強のKEN_ALL.csv 2017/10/21

##それでもとりあえずKEN_ALLをやっておきます
###Ken_AllフォルダにSchema.iniを作成する
Schema.iniはANSI形式テキストにします。

[KEN_ALL.csv]
MaxScanRows = 1
ColNameHeader = False
characterSet = ANSI
Format = CSVDelimited
Col1="F01都道府県市区町村コード" Text Width 5
Col2="F02P01" Text Width 3
Col3="F03P02" Text Width 7
Col4="F04県ヨミ" Text Width 255
Col5="F05市ヨミ" Text Width 255
Col6="F06町ヨミ" Text Width 255
Col7="F07県" Text Width 255
Col8="F08市" Text Width 255
Col9="F09町" Text Width 255
Col10="F10" Bit
Col11="F11" Bit
Col12="F12" Bit
Col13="F13" Bit
Col14="F14" Bit
Col15="F15" Bit

次にAccessを開きます Ken All Tableという名前のテーブルを作り、自動的に読み込みます。
Constで定義し、アポストロフで注釈にしていますが conという変数に代入する方法は、
oledb
Jet
Text Driver(要インストール)
を用意しました。
Dim strPath: strPath = "C:\ken_all\"
にフォルダを指定してください。Schemaもそこに作成します。
###Ken_All.CSVをテーブルを作って流し込むコード

Sub CreateSQLKenAll()
Const adOpenStatic = 3, adLockOptimistic = 3, adOpenDynamic = 2, adOpenForwardOnly = 0
Const adLockReadOnly = 1
Const adModeRead = 1, adModeReadWrite = 3 '[mConnectModeEnum](https://docs.microsoft.com/ja-jp/sql/ado/reference/ado-api/connectmodeenum)
Const adCmdText = &H1
Const Prov12_AC2010 = "Provider = Microsoft.ACE.OLEDB.12.0;Data Source="
Const Prov15_AC2013 = "Provider = Microsoft.ACE.OLEDB.15.0;Data Source="
Const Prov16_AC2016 = "Provider = Microsoft.ACE.OLEDB.16.0;Data Source="
Const Jet40Provider = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Const consReadOnlyTrue = ";ReadOnly=1"
Const exPropHDRNO_FMT_CSV = ";Extended Properties='text;HDR=NO;FMT=Delimited'"
Const exPropHDRNO_FMT_CSV2 = ";Extended Properties=""text;HDR=NO;FMT=Delimited;"";"
Const exPropHDRYes_FMT_CSV3 = ";Extended Properties=""text;HDR=YES;FMT=Delimited"""
Const exPropHDRNo_FMT_CSV3 = ";Extended Properties=""text;HDR=No;FMT=Delimited"""
Const TxtDriver = "Driver={Microsoft Text Driver (*.txt; *.csv)};DBQ="
Const TxtDriver2 = ";Extensions=asc,csv,tab,txt;"
Const TxtDriverB = "Provider=MSDASQL;Driver={Microsoft Text Driver (*.txt; *.csv)};DefaultDir="
Const TxtDriverHDR = ";FirstRowHasNames=0;"
Const TgTN = "KEN_ALL.CSV" 'KEN_ALL#CSVとしてもよい。http://home.att.ne.jp/zeta/gen/excel/c04p47.htm
Const strFolder = "E:\Ken_All\\"
Dim Conn As ADODB.Connection: Set Conn = New ADODB.Connection
Dim CAT: Set CAT = CreateObject("ADOX.Catalog") ': CAT.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "E:\Ken_All\Ken_All.csv"
Dim CTBL As ADOX.Table
Dim cDB As dao.Database: Set cDB = CurrentDb
Dim aRs As ADODB.Recordset: Set aRs = New ADODB.Recordset
Dim Cn As ADODB.Connection: Set Cn = New ADODB.Connection
Set Conn = New ADODB.Connection

Dim aComm As ADODB.Command: Set aComm = New ADODB.Command
Dim i As Long
Dim sSQL
Dim strPath: strPath = "C:\\ken_all\\"
Dim fld, RS, mSQL, FileName
On Error Resume Next
DoCmd.RunSQL "DROP TABLE [KEN ALL TABLE]"
On Error GoTo 0
If Err.Number <> 0 Then Err.Clear
sSQL = "CREATE TABLE [KEN ALL TABLE](ID COUNTER PRIMARY KEY,F01都道府県市区町村コード CHAR(5), [F02P01] Text(3), [F03P02] Text(7), [F04県ヨミ] Text(255), [F05市ヨミ] Text(255),[F06町ヨミ] Text (255), [F07県] Text (255), [F08市] Text (255), [F09町] TEXT(255), [F10] BIT, [F11] BIT, [F12] BIT, [F13] BIT, [F14] BIT, [F15] BIT);"
DoCmd.RunSQL sSQL
'[Conの4つのうち1つを選ぶコードの記述方法]-----------------
con = Prov16_AC2016 & strFolder & exPropHDRNo_FMT_CSV3: Debug.Print con '32bitで起動スキーマがあるとヘッダー名は読む(Access2016)
'con = Prov15_AC2013 & strFolder & exPropHDRNo_FMT_CSV3: Debug.Print con '32bitで起動スキーマがあるとヘッダー名は読む(Access2013)
'Con = Jet40Provider & strFolder & exPropHDRNO_FMT_CSV : Debug.Print Con '32bitで起動スキーマがあるとヘッダー名は読む
'Con = TxtDriver & strFolder & TextDriver2 & consReadOnlyTrue & exPropHDRNo_FMT_CSV3 '32bitで起動。スキーマがあるとヘッダー名は読む。ReadOnlyはエラーにならない。
'Con = TxtDriverB & strFolder & TxtDriverHDR & exPropHDRNo_FMT_CSV3
Conn.Open con
sSQL = "SELECT * FROM [" & TgTN & "];"
'aRs.Open sSQL, Conn, adOpenDynamic ', adOpenStatic, 0 = adLockReadOnly '[recordset.Open Source, ActiveConnection, CursorType, LockType, Options](https://msdn.microsoft.com/ja-jp/library/cc364218.aspx)
Set CAT = CurrentProject.Connection
aRs.Open sSQL, Conn, adOpenDynamic
Set RS = cDB.OpenRecordset("KEN ALL TABLE", adOpenDynamic)
aRs.MoveFirst

Do While aRs.EOF = False
RS.AddNew
For i = 1 To RS.Fields.Count - 1
'Debug.Print i, RS.Fields(i).Name, aRs.Fields(i - 1).Name
RS.Fields(i).Value = aRs.Fields(i - 1)
Next
RS.Update
aRs.MoveNext
Loop
End Sub