Excel VBA | ADOで郵便番号から住所を検索して別シートに出力するバッチ処理の応用例

Sub PostalCodeBatchExport()
    Dim conn As Object, rs As Object
    Dim filePath As String, code As String
    Dim wsSource As Worksheet, wsResult As Worksheet
    Dim lastRow As Long, i As Long
    
    ' CSVファイルのパス（日本郵便公式のKEN_ALL.CSVをダウンロードして指定）
    filePath = "C:\data\KEN_ALL.CSV"
    
    ' 元データシート（郵便番号がA列にある）
    Set wsSource = ThisWorkbook.Sheets("顧客リスト")
    
    ' 結果出力用シート（なければ作成）
    On Error Resume Next
    Set wsResult = ThisWorkbook.Sheets("住所結果")
    If wsResult Is Nothing Then
        Set wsResult = ThisWorkbook.Sheets.Add
        wsResult.Name = "住所結果"
    End If
    On Error GoTo 0
    
    ' ADO接続を作成
    Set conn = CreateObject("ADODB.Connection")
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & Left(filePath, InStrRev(filePath, "\")) & ";" & _
              "Extended Properties=""text;HDR=No;FMT=Delimited"""
    
    ' 元データの最終行を取得
    lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    
    ' ヘッダー行を設定
    wsResult.Cells(1, 1).Value = "郵便番号"
    wsResult.Cells(1, 2).Value = "都道府県"
    wsResult.Cells(1, 3).Value = "市区町村"
    wsResult.Cells(1, 4).Value = "町域"
    
    ' 郵便番号を順に検索して結果を別シートに出力
    For i = 2 To lastRow
        code = Replace(wsSource.Cells(i, 1).Value, "-", "") ' ハイフン削除
        
        ' SQLで検索（KEN_ALL.CSVの仕様: F3=郵便番号, F6=都道府県, F7=市区町村, F8=町域）
        Set rs = conn.Execute("SELECT F6, F7, F8 FROM [" & Mid(filePath, InStrRev(filePath, "\") + 1) & "] WHERE F3='" & code & "'")
        
        wsResult.Cells(i, 1).Value = wsSource.Cells(i, 1).Value ' 元の郵便番号
        
        If Not rs.EOF Then
            wsResult.Cells(i, 2).Value = rs.Fields(0).Value ' 都道府県
            wsResult.Cells(i, 3).Value = rs.Fields(1).Value ' 市区町村
            wsResult.Cells(i, 4).Value = rs.Fields(2).Value ' 町域
        Else
            wsResult.Cells(i, 2).Value = "不明"
            wsResult.Cells(i, 3).Value = "不明"
            wsResult.Cells(i, 4).Value = "不明"
        End If
        rs.Close
    Next i
    
    conn.Close
End Sub

Sub PostalCodeBatchExport()
    Dim conn As Object, rs As Object
    Dim filePath As String, code As String
    Dim wsSource As Worksheet, wsResult As Worksheet
    Dim lastRow As Long, i As Long
    
    ' CSVファイルのパス（日本郵便公式のKEN_ALL.CSVをダウンロードして指定）
    filePath = "C:\data\KEN_ALL.CSV"
    
    ' 元データシート（郵便番号がA列にある）
    Set wsSource = ThisWorkbook.Sheets("顧客リスト")
    
    ' 結果出力用シート（なければ作成）
    On Error Resume Next
    Set wsResult = ThisWorkbook.Sheets("住所結果")
    If wsResult Is Nothing Then
        Set wsResult = ThisWorkbook.Sheets.Add
        wsResult.Name = "住所結果"
    End If
    On Error GoTo 0
    
    ' ADO接続を作成
    Set conn = CreateObject("ADODB.Connection")
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & Left(filePath, InStrRev(filePath, "\")) & ";" & _
              "Extended Properties=""text;HDR=No;FMT=Delimited"""
    
    ' 元データの最終行を取得
    lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    
    ' ヘッダー行を設定
    wsResult.Cells(1, 1).Value = "郵便番号"
    wsResult.Cells(1, 2).Value = "都道府県"
    wsResult.Cells(1, 3).Value = "市区町村"
    wsResult.Cells(1, 4).Value = "町域"
    
    ' 郵便番号を順に検索して結果を別シートに出力
    For i = 2 To lastRow
        code = Replace(wsSource.Cells(i, 1).Value, "-", "") ' ハイフン削除
        
        ' SQLで検索（KEN_ALL.CSVの仕様: F3=郵便番号, F6=都道府県, F7=市区町村, F8=町域）
        Set rs = conn.Execute("SELECT F6, F7, F8 FROM [" & Mid(filePath, InStrRev(filePath, "\") + 1) & "] WHERE F3='" & code & "'")
        
        wsResult.Cells(i, 1).Value = wsSource.Cells(i, 1).Value ' 元の郵便番号
        
        If Not rs.EOF Then
            wsResult.Cells(i, 2).Value = rs.Fields(0).Value ' 都道府県
            wsResult.Cells(i, 3).Value = rs.Fields(1).Value ' 市区町村
            wsResult.Cells(i, 4).Value = rs.Fields(2).Value ' 町域
        Else
            wsResult.Cells(i, 2).Value = "不明"
            wsResult.Cells(i, 3).Value = "不明"
            wsResult.Cells(i, 4).Value = "不明"
        End If
        rs.Close
    Next i
    
    conn.Close
End Sub