LoginSignup
0
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

@Q11Q

ACCESS VBA 郵便番号を取り込むテーブルを作ってCSVから取り込む（事業所）

Posted at

データの用意

郵便番号データダウンロード
から事業所の分をダウンロードします。

TAble.vb
Sub maketbl()
Dim db As Database: Set db = CurrentDb
Dim CP: Set CP = CurrentProject
Dim con As New ADODB.Connection, rec As New ADODB.Recordset
Dim CN As ADODB.Connection
Dim Tbl As DAO.TableDef: Set Tbl = db.CreateTableDef("事業所ODBC")
Dim rs1 As ADODB.Recordset
Dim flds As Fields, fld As Field, prp As DAO.Property
Dim i As Long
Dim idx As DAO.Index
Application.RefreshDatabaseWindow
On Error Resume Next
db.Execute ("DROP TABLE 事業所ODBC2;")
On Error GoTo 0
'http://www.accessclub.jp/bbs/0003/beginers1248.html
'http://www.accessclub.jp/bbs5/0007/vba1603.html
'http://www.accessclub.jp/bbs/0052/beginers20530.html
'http://webcache.googleusercontent.com/search?q=cache:xOIEMTHMhCAJ:tsware.jp/study/vol1/kaibo_08.htm+&cd=1&hl=ja&ct=clnk&gl=jp
'https://msdn.microsoft.com/ja-jp/library/office/ff836607.aspx
'https://msdn.microsoft.com/ja-jp/library/office/ff822050.aspx
'http://www.ruriplus.com/msaccess/Exp/exp0143.htm

With Tbl
Set fld = .CreateField("ID", dbLong)
fld.Attributes = dbAutoIncrField
.Fields.Append Object:=fld
.Fields.Append .CreateField("所在地", dbText, 255)
.Fields.Append .CreateField("事業所名よみ", dbText, 100)
.Fields.Append .CreateField("事業所名", dbText, 255)
.Fields.Append .CreateField("都道府県名", dbText, 10)
.Fields.Append .CreateField("市区町村名", dbText, 48)
.Fields.Append .CreateField("町域名", dbText, 48)
.Fields.Append .CreateField("小字名、丁目、番地等", dbText, 255)
.Fields.Append .CreateField("大口事業所個別番号", dbText, 18)
.Fields.Append .CreateField("旧郵便番号", dbText, 10)
.Fields.Append .CreateField("取扱局", dbText, 80)
.Fields.Append .CreateField("個別番号の種別", dbText, 100)
.Fields.Append .CreateField("複数番号の有無", dbText, 80)
.Fields.Append .CreateField("修正コード", dbText, 8)
End With
With Tbl
    Set idx = .CreateIndex("PrimaryKey")
    idx.Fields.Append idx.CreateField("ID")
    idx.Primary = True
    idx.CreateProperty "ID", dbLong
    .Indexes.Append idx
End With
db.TableDefs.Append Tbl
db.TableDefs.Refresh
Application.RefreshDatabaseWindow
With Tbl
Set fld = .Fields("所在地")
Set prp = fld.CreateProperty("Description", dbText, "大口事業所の所在地のJISコード（5バイト）")
fld.Properties.Append prp
fld.Properties.Refresh
Set fld = .Fields("事業所名よみ")
Set prp = fld.CreateProperty("Description", dbText, "大口事業所名（カナ）（100バイト）")
fld.Properties.Append prp
fld.Properties.Refresh
Set fld = .Fields(9)
Set prp = fld.CreateProperty("Description", dbText, "旧郵便番号（5バイト）")
fld.Properties.Append prp
fld.Properties.Refresh
Set fld = .Fields(10)
Set prp = fld.CreateProperty("Description", dbText, "取扱局（漢字）（40バイト）")
fld.Properties.Append prp
fld.Properties.Refresh
Set fld = .Fields("個別番号の種別")
Set prp = fld.CreateProperty("Description", dbText, "「0」大口事業所 「1」私書箱")
fld.Properties.Append prp
fld.Properties.Refresh
Set fld = .Fields(12)
Set prp = fld.CreateProperty("Description", dbText, "「0」複数番号無し「1」複数番号を設定している場合の個別番号の1" & _
"「2」複数番号を設定している場合の個別番号の2 " & _
"「3」複数番号を設定している場合の個別番号の3")
fld.Properties.Append prp
fld.Properties.Refresh
Set fld = .Fields(13)
Set prp = fld.CreateProperty("Description", dbText, "「0」修正なし 「1」新規追加 「5」廃止")
fld.Properties.Append prp
fld.Properties.Refresh
db.TableDefs.Refresh
End With
DoCmd.OpenTable Tbl.Name, acViewDesign, acEdit
End Sub
Sub Sample02forAccess事業所ODBC()
Dim db As Database: Set db = CurrentDb
Dim CP: Set CP = CurrentProject
Dim con As New ADODB.Connection, rec As New ADODB.Recordset
Dim CN As ADODB.Connection
Dim Tbl As TableDef: Set Tbl = db.TableDefs("事業所ODBC")
Dim rs1 As ADODB.Recordset
Dim flds As Fields: Dim fld As Field
Dim i As Long
        With con
            .ConnectionString = "Driver={Microsoft Text Driver (*.txt; *.csv)};DBQ=E:\jigyosyo\;"
            .Open
        End With
rec.Open "select * from JIGYOSYO.CSV", con 'Filename
rec.MoveFirst
Tbl.OpenRecordset , acTable
Set CN = CP.Connection
Set rs1 = New ADODB.Recordset
rs1.Open "事業所ODBC", CN, adOpenKeyset, adLockOptimistic
Do Until rec.EOF = True
rs1.AddNew
For i = 1 To rs1.Fields.Count - 1
If i < 11 Then
rs1.Fields(i).Value = rec.Fields.Item(i - 1).Value
ElseIf i >= 11 And i < 12 Then
  If rec.Fields.Item(i - 1).Value = 0 Then rs1.Fields(i).Value = "大口事業所" Else rs1.Fields(i).Value = "私書箱"
ElseIf i = 12 Then
   Select Case rec.Fields.Item(i - 1).Value
   Case Is = 0
   rs1.Fields(i).Value = "複数番号無し"
   Case Is = 1
   rs1.Fields(i).Value = "複数番号を設定している場合の個別番号の1"
   Case Is = 2
   rs1.Fields(i).Value = "複数番号を設定している場合の個別番号の2"
   Case Is = 3
   rs1.Fields(i).Value = "複数番号を設定している場合の個別番号の3"
   End Select
ElseIf i = 13 Then
   Select Case rec.Fields.Item(i - 1).Value
   Case Is = 0
   rs1.Fields(i).Value = "修正なし"
   Case Is = 1
   rs1.Fields(i).Value = "新規追加"
   Case Is = 5
   rs1.Fields(i).Value = "廃止"
   Case Else
  rs1.Fields(i).Value = "不明"
   End Select
End If
Next i
rs1.Update
rec.MoveNext
Loop
rs1.Close
rec.Close
Set rs1 = Nothing
Set rec = Nothing
End Sub

ポイント

1.Makeテーブル まず主キーの作り方。dbLongでプロパティをアペンドする。オートナンバーのタイプ設定。dblong+attribute
2.また説明文の追加（デザインビューでのフィールドの説明）
3.データ取り込みはODBCにしました。ODBCはインストールが必要です。
4.DBQ=E:\jigyosyo\ 最後がフォルダ名で\が必要。DBQもポイントか
5.rec.Open "select * from JIGYOSYO.CSV", con ここでファイル名だけ入る。フルパスではない。
にある

ODBCではなくJetのとき

JET.vb
Sub Sample01forAccess()
Dim db As Database: Set db = CurrentDb
Dim CP: Set CP = CurrentProject
Dim con As New ADODB.Connection, rec As New ADODB.Recordset
Dim CN As ADODB.Connection
Dim Tbl As TableDef: Set Tbl = db.TableDefs("事業所ODBC")
Dim rs1 As ADODB.Recordset
Dim flds As Fields: Dim fld As Field
Dim i As Long
With con
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\jigyosyo\;" _
& "Extended Properties='text;HDR=No;FMT=Delimited'"
.Open
End With
rec.Open "select * from JIGYOSYO.CSV", CN
rec.MoveFirst
Tbl.OpenRecordset , acTable
Set CN = CP.Connection
Set rs1 = New ADODB.Recordset
rs1.Open "事業所ODBC", CN, adOpenKeyset, adLockOptimistic
Do Until rec.EOF = True
rs1.AddNew
For i = 1 To rs1.Fields.Count - 1
If i < 11 Then
rs1.Fields(i).Value = rec.Fields.Item(i - 1).Value
ElseIf i >= 11 And i < 12 Then
  If rec.Fields.Item(i - 1).Value = 0 Then rs1.Fields(i).Value = "大口事業所" Else rs1.Fields(i).Value = "私書箱"
ElseIf i = 12 Then
   Select Case rec.Fields.Item(i - 1).Value
   Case Is = 0
   rs1.Fields(i).Value = "複数番号無し"
   Case Is = 1
   rs1.Fields(i).Value = "複数番号を設定している場合の個別番号の1"
   Case Is = 2
   rs1.Fields(i).Value = "複数番号を設定している場合の個別番号の2"
   Case Is = 3
   rs1.Fields(i).Value = "複数番号を設定している場合の個別番号の3"
   End Select
ElseIf i = 13 Then
   Select Case rec.Fields.Item(i - 1).Value
   Case Is = 0
   rs1.Fields(i).Value = "修正なし"
   Case Is = 1
   rs1.Fields(i).Value = "新規追加"
   Case Is = 5
   rs1.Fields(i).Value = "廃止"
   Case Else
  rs1.Fields(i).Value = "不明"
   End Select
End If
Next i
rs1.Update
rec.MoveNext
Loop
rs1.Close
rec.Close
Set rs1 = Nothing
Set rec = Nothing
End Sub
0
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?