アプリケーションとしてのVBA Excel(エクセル) VBA の役立つ Tips の紹介

アプリケーションとしてのVBA

郵便番号のデータベースを作成



郵便番号のデータベースを作成


  郵便番号のデータベースを作成してみましょう。
  
  これは、次に紹介する住所から郵便番号に変換するマクロの前準備です。
  
  元データは日本郵便のホームページからダウンロードします。
  
  「全国一括」をダウンロードしてください。
  
  ダウンロードしたCSVは、1,000,000 行以上あるので、Input関数を使用して
  読み込んでいます。
  
  INSERT文は使用しないで、DB_Record.AddNew で時間を短縮しています。
  
  詳しくは説明しませんが、サンプル をダウンロードして動かしてみてください。

  

Public Const ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="

'空の 郵便番号.mdb を作成し、テーブル(Zip_Code(郵便番号))を作成
Sub Create_ZipMDB()

    Dim DB_Catalog                      As ADOX.Catalog
    Dim DB_Connect                      As ADODB.Connection
    Dim DB_Cmd                          As ADODB.Command
    
    Dim FileSystemOBJ                   As Object
    Dim MDB_FolderPath                  As String
    
    Const DB_Name = "郵便番号.mdb"
    
    'mdb ファイルを作成するフォルダのパスを設定
    MDB_FolderPath = FolderPath

    Set FileSystemOBJ = CreateObject("Scripting.FileSystemObject")
    
    '郵便番号.mdb が、既に存在するか確認
    If FileSystemOBJ.FileExists(MDB_FolderPath & "\" & DB_Name) Then
        '存在する場合は削除する
        FileSystemOBJ.DeleteFile MDB_FolderPath & "\" & DB_Name
    End If
    
    Set FileSystemOBJ = Nothing
    
    Set DB_Catalog = New ADOX.Catalog
    
    '郵便番号.mdb を作成
    DB_Catalog.Create ConnectionString & MDB_FolderPath & "\" & DB_Name & ";"
    
    Set DB_Catalog = Nothing
    
    
    'Zip_Code(郵便番号) テーブルの作成

    Set DB_Connect = New ADODB.Connection
    
    DB_Connect.Open ConnectionString & MDB_FolderPath & "\" & DB_Name & ";"
    
    Set DB_Cmd = New ADODB.Command

    DB_Cmd.ActiveConnection = DB_Connect

    '既にZip_Codeテーブルが存在していたら削除する
    DB_Cmd.CommandText = "DROP TABLE Zip_Code"

    'Zip_Codeテーブルが存在してたらエラーになるので On Error で落ちるの回避
    On Error Resume Next
    DB_Cmd.Execute
    On Error GoTo 0
    
    DB_Cmd.ActiveConnection = DB_Connect
    
'            "CODE1"      全国地方公共団体コード
'            "ZIP_OLD"    旧郵便番号
'            "ZIPCODE"    郵便番号
'            "KEN_KANA"   都道府県名(カナ)
'            "SHI_KANA"   市区町村名(カナ)
'            "CHO_KANA"   町域名(カナ)
'            "KEN_KANJI"  都道府県名
'            "SHI_KANJI"  市区町村名
'            "CHO_KANJI"  町域名
'            "FLG1"       一町域が二以上の郵便番号
'            "FLG2"       小字毎に番地が起番されている
'            "FLG3"       丁目を有する町域
'            "FLG4"       一つの郵便番号で二以上の町域
'            "FLG5"       更新の表示
       
    'Zip_Code テーブルの作成
    DB_Cmd.CommandText = "CREATE TABLE Zip_Code (" & _
                         "CODE1     INTEGER ," & _
                         "ZIP_OLD   TEXT(5)," & _
                         "ZIPCODE   TEXT(7)," & _
                         "KEN_KANA  TEXT(50)," & _
                         "SHI_KANA  TEXT(50)," & _
                         "CHO_KANA  TEXT(100)," & _
                         "KEN_KANJI TEXT(50)," & _
                         "SHI_KANJI TEXT(50)," & _
                         "CHO_KANJI TEXT(100)," & _
                         "FLG1      INTEGER," & _
                         "FLG2      INTEGER," & _
                         "FLG3      INTEGER," & _
                         "FLG4      INTEGER," & _
                         "FLG5      INTEGER," & _
                         "FLG6      INTEGER )"
       
    DB_Cmd.Execute
       
    Set DB_Cmd = Nothing
    
    DB_Connect.Close
    
    Set DB_Connect = Nothing
        
End Sub


'ダウンロードした CSVからデータを郵便番号.mdb に挿入
Sub Insert_Zip()

    Dim DB_Connect                      As ADODB.Connection
    Dim DB_Record                       As ADODB.Recordset
    
    Dim FieldList                       As Variant
    Dim ZipData(14)                     As Variant
    
    Dim File種類                        As String
    Dim Prompt                          As String
    Dim FileNamePath                    As Variant
    Dim MDB_Path                        As String
    
    Dim ch1 As Long
        
    '郵便番号.csv のパスを取得します
    File種類 = "CSV ファイル (*.CSV),*.CSV"
    Prompt = "郵便番号データファイル CSV (全国一括)を選択してください"
    FileNamePath = Application.GetOpenFilename(File種類, , Prompt)

    If FileNamePath = False Then
        End
    End If
        
    'mdbファイルのパスを設定
    File種類 = "mdb (*.mdb),*mdb"
    Prompt = "郵便番号.mdb を選択してください。"
    MDB_Path = Application.GetOpenFilename(File種類, , Prompt)

    
    '空いているファイル番号を取得します
    ch1 = FreeFile
    
    'CSVファイルを開く
    Open FileNamePath For Input As #ch1
    
    '接続を確立する
    Set DB_Connect = New ADODB.Connection
    
    'コネクト(接続)する .mdb ファイルの設定
    DB_Connect.Open ConnectionString & MDB_Path & ";"
    
    Set DB_Record = New ADODB.Recordset
    
    DB_Record.Open "Zip_Code", DB_Connect, adOpenForwardOnly, adLockOptimistic
    
    
    ' CSVからMDBに登録する項目ID(番号)を配列に列挙する
    FieldList = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14)
    
    'CSVファイルのEOF(End of File)まで繰り返す
    Do Until EOF(ch1)
    
        ' レコードを読み込む
       Input #ch1, ZipData(0), ZipData(1), ZipData(2), ZipData(3), ZipData(4), _
                   ZipData(5), ZipData(6), ZipData(7), ZipData(8), ZipData(9), _
                   ZipData(10), ZipData(11), ZipData(12), ZipData(13), ZipData(14)
                
        '.mdb にレコード追加
        DB_Record.AddNew FieldList, ZipData
        
    Loop
    
    
    'ファイルを閉じる
    Close #ch1
    
    DB_Record.Close
    
    Set DB_Record = Nothing
    
    DB_Connect.Close
    
    Set DB_Connect = Nothing


End Sub




Copy (C) 2005   アプリケーションとしてのVBA   All Rights Reserved.