Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


70410 / 76738 ←次へ | 前へ→

【10835】Re:CSVから直接MDBを作成したい 別解
回答  ichinose  - 04/2/15(日) 23:29 -

引用なし
パスワード
   ▼kawata さん:
こんばんは。
オートナンバーの設定方法がやっとわかったので、訂正します。
前準備までは、前回投稿したとおりに作成してください。

以下のコードで、
「D:\EXCELファイル\ADO関連」というフォルダに
「yubinsamp.mdb」というmdbファイルを作成し、
同じ「D:\EXCELファイル\ADO関連」というフォルダにある「Ken_all.csv」というファイルを「schema.ini」を基にインポートし、「郵便番号」というテーブルを「yubinsamp.mdb」に作成します。
但し、テーブル「郵便番号」には、idというフィールドが新たに作成され型はオートナンバーでこれが主キーになります。
標準モジュール(Module1)に
'===============================================================
Sub main()
  Dim dbpath As String
  Dim nm(0 To 15)
  Dim tp
  Dim att
  nm(0) = "id"
  For idx = 1 To 15
   nm(idx) = "フィールド" & idx
   Next
  tp = Array(3, 3, 202, 202, 202, 202, 202, 202, 202, 202, 3, 3, 3, 3, 3, 3)
  att = Array(True, False, False, False, False, False, False, False, False, False, False, False, False, False, False, False)
'↑テーブルの構成を定義
  dbpath = "D:\EXCELファイル\ADO関連\yubinsamp.mdb"
  Call delete_fl(dbpath)
  If create_cat(dbpath) = 0 Then
   If create_tbl("郵便番号", nm(), tp, att) = 0 Then
     sqlstr = "insert into [郵便番号] SELECT * FROM [Text;DATABASE=D:\EXCELファイル\ADO関連\].Ken_all.csv"
     If Exec(sqlstr) = 0 Then
      MsgBox "インポート成功"
      End If
     End If
   Call close_cat
   End If
End Sub

標準モジュール(module2)に(前回の投稿ではmodule1になっていましたね、module2です、訂正)、
'===============================================================
Private cat As ADOX.Catalog
Function create_cat(flnm As String) As Long
  On Error Resume Next
  Set cat = New ADOX.Catalog
  cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & flnm
  create_cat = Err.Number
  On Error GoTo 0
End Function
'===============================================================
Sub close_cat()
  cat.ActiveConnection.Close
  Set cat = Nothing
End Sub
'===============================================================
Function Exec(sql_str) As Long
  On Error Resume Next
  Exec = 0
  cat.ActiveConnection.Execute sql_str
  If Err.Number <> 0 Then
    Exec = Err.Number
    End If
  On Error GoTo 0
End Function
'===============================================================
Sub delete_fl(flnm)
  On Error Resume Next
  Kill flnm
  On Error GoTo 0
End Sub
'===============================================================
Function create_tbl(tblnm As String, nmarray, tparray, attarray) As Long
'tblnmというテーブルを作成し、最初の列に主キーを設定する
'Input:tblnm----テーブル名
'   nmarray----列の名前の配列
'   tparray----列のタイプの配列
'   attarray---列のオートナンバーか否かの配列 Trueオートナンバー、falseオートナンバーでない
  On Error GoTo err_create_tbl
  Dim RS As ADODB.Recordset
  Dim tbl As ADOX.Table
  Dim col As ADOX.Column
  Dim kky As ADOX.Key
  create_tbl = 0
  Set tbl = New ADOX.Table
  tbl.name = tblnm
  jdx = 0
  For idx = LBound(nmarray) To UBound(nmarray)
    Set col = New ADOX.Column
    With col
     .name = nmarray(idx)
     .type = tparray(idx)
     Set .ParentCatalog = cat
     .Properties("AutoIncrement") = attarray(idx)
     .DefinedSize = 100
     End With
    tbl.Columns.Append col
    Set col = Nothing
    Next idx
  cat.Tables.Append tbl
  Set kky = New ADOX.Key
  cat.Tables(tblnm).Keys.Append nmarray(LBound(nmarray)), adKeyPrimary, nmarray(LBound(nmarray))
  Set tbl = Nothing
  Set col = Nothing
  On Error GoTo 0
ret_create_tbl:
  Exit Function
err_create_tbl:
  MsgBox Error(Err.Number)
  create_tbl = Err.Number
  Resume ret_create_tbl
End Function

前回の投稿と合わせて確認してみて下さい。
私の環境では、30秒未満程で処理が終わりました。

それと私は、他のDBにつなぐこともあるので、ADOを使っていますが、
mdbファイル特別な設定などは、調べるのが大変です(私は、テーブルの作成などは
アクセスで大抵やってしまうので、あまり不便は感じませんが)。
勉強にはなりますが、
DAOを使えば、今回のようなオートナンバーの設定などは簡単です。
お聞きした限り、Accessのない環境だということですが、
mdbファイルを操作するという限りでは、DAOの方が便利そうですよ。
1 hits

【10759】CSVから直接MDBを作成したい kawata 04/2/12(木) 15:10 質問
【10787】Re:CSVから直接MDBを作成したい ichinose 04/2/13(金) 21:23 回答
【10789】Re:CSVから直接MDBを作成したい kawata 04/2/13(金) 23:32 お礼
【10835】Re:CSVから直接MDBを作成したい 別解 ichinose 04/2/15(日) 23:29 回答
【10836】訂正と追伸 ichinose 04/2/15(日) 23:38 発言
【10842】Re:訂正と追伸 kawata 04/2/16(月) 10:23 お礼
【10844】Re:訂正と追伸 ichinose 04/2/16(月) 11:01 発言
【10845】Re:訂正と追伸 kawata 04/2/16(月) 11:13 お礼
【10857】Re:訂正と追伸 kawata 04/2/16(月) 15:04 お礼
【10837】Re:CSVから直接MDBを作成したい 別解 kawata 04/2/16(月) 8:29 お礼
【10843】Re:CSVから直接MDBを作成したい 別解 kawata 04/2/16(月) 10:56 回答

70410 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free