Sub MyZipBook()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 都道府県別 郵便番号簿 作成処理
  Rem 作譜：Hitrock Camellia Shinopy
  Rem 言語：Excel VBA
  Rem 機能...
  Rem   都道府県別に郵便番号データをブックに取り込みする。
  Rem 注記...
  Rem   1. 実行前に日本郵政公社のサイトから、
  Rem      郵便番号データファイルの[全国一括]データをダウンロードしておくこと。
  Rem      （ http://www.post.japanpost.jp/zipcode/dl/kogaki.html ）
  Rem   2. MyZipBookReportFootプロシージャ（[プロパティ]の設定）を
  Rem      必要に応じて確認／更新すること。
  Rem   3. 実行前に「myFile」に郵便番号データファイルの保存先を指定すること。
  Rem   4. MyZipBookを起動して実行。
  Rem 履歴...
  Rem   第01版：2007/07/20：作成。
  Rem   第02版：2007/07/23：エラー処理・プロパティ設定を追加。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myFile As String
  Dim myBuffer As String
  Dim tmp As Variant
  Dim myPrefPrev As String
  Dim r As Long
  Dim i As Long
  Dim myMax As Long
  Dim myStatusBar As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myFile = "C:\Documents and Settings\User\My Documents\Download\郵便番号\KEN_ALL.CSV"
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Application.CommandBars("Task Pane").Visible = False
  On Error Resume Next
  Open myFile For Input As #1
  Line Input #1, myBuffer
  '
  If Err.Number <> 0 Then
    myStatusBar = Err.Description
    Application.Speech.Speak myStatusBar, True
    myStatusBar = "MyZipBook" & ": " & myStatusBar
    Application.StatusBar = myStatusBar
    Close #1
    Exit Sub
  End If
  On Error GoTo 0
  If EOF(1) Then Exit Sub
  '
  Application.ScreenUpdating = False
  '
  myBuffer = Replace(myBuffer, Chr(34), "")
  tmp = Split(myBuffer, ",")
  '
  myPrefPrev = tmp(6)
  Call MyZipBookPageHead
  ActiveSheet.Name = myPrefPrev
  Close #1
  '
  Rem  なぜか、データ件数が1つ多い数字を取得するため、1を減算。
  Rem  （郵便番号データファイルの[全国一括]データ 平成19年6月29日更新版での現象）
  With CreateObject("Scripting.FileSystemObject").OpenTextFile(myFile, 8)
    myMax = .Line - 1
    .Close
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  r = 0
  i = 0
  Open myFile For Input As #1
  '
  Do Until EOF(1)
    r = r + 1
    i = i + 1
    Line Input #1, myBuffer
    '
    myBuffer = Replace(myBuffer, Chr(34), "")
    tmp = Split(myBuffer, ",")
    '
    If tmp(6) <> myPrefPrev Then
      On Error Resume Next
      ActiveSheet.Next.Select
      If Err.Number <> 0 Then
        Worksheets.Add After:=ActiveSheet
      End If
      On Error GoTo 0
      '
      myPrefPrev = tmp(6)
      Call MyZipBookPageHead
      ActiveSheet.Name = myPrefPrev
      r = 1
    End If
    Cells(r, 1).Resize(1, 9) = tmp
    '
    If Cells(r, 1).Errors(xlNumberAsText).Value = True Then
      Cells(r, 1).Errors(xlNumberAsText).Ignore = True
    End If
    If Cells(r, 2).Errors(xlNumberAsText).Value = True Then
      Cells(r, 2).Errors(xlNumberAsText).Ignore = True
    End If
    If Cells(r, 3).Errors(xlNumberAsText).Value = True Then
      Cells(r, 3).Errors(xlNumberAsText).Ignore = True
    End If
    '
    myStatusBar = i * 100 \ myMax & "%  " & i & "/" & myMax & "件　"
    myStatusBar = "[" & ActiveSheet.Name & "]：" & myStatusBar
    Application.StatusBar = "MyZipBook" & "：" & myStatusBar
    '
    DoEvents
  Loop
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Application.ScreenUpdating = True
  Close #1
  '
  Call MyZipBookReportFoot
  myStatusBar = "処理が終了しました。"
  Application.Speech.Speak myStatusBar, True
  myStatusBar = "MyZipBook" & ": " & myStatusBar & Now() & " "
  Application.StatusBar = myStatusBar & i & "件"
End Sub ' MyZipBook *----*----*    *----*----*    *----*----*    *----*----*

Sub MyZipBookPageHead(Optional myDummy As Boolean)
  Columns("A:I").Select
  Selection.NumberFormatLocal = "@"
  '
  Columns("G:G").Select
  Selection.ColumnWidth = 9
  '
  Columns("H:H").Select
  Selection.ColumnWidth = 16
  '
  Range("A1").Select
End Sub ' MyZipBookPageHead *----*----*    *----*----*    *----*----*    *----*----*

Sub MyZipBookReportFoot(Optional myDummy As Boolean)
  Rem [プロパティ]の設定
  Rem タイトル・サブタイトル・ハイパーリンクの基点
  ActiveWorkbook.BuiltinDocumentProperties("Title") = "郵便番号簿"
  ActiveWorkbook.BuiltinDocumentProperties("Subject") = "平成19年 7月 31日更新版"
  ActiveWorkbook.BuiltinDocumentProperties("Hyperlink base") = "http://www.post.japanpost.jp/zipcode/dl/kogaki.html"
End Sub ' MyZipBookReportFoot *----*----*    *----*----*    *----*----*    *----*----*