Excel VBA質問箱 IV

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

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


71414 / 76732 ←次へ | 前へ→

【9811】アクセスへエクスポートする方法
質問  hana  - 03/12/17(水) 15:43 -

引用なし
パスワード
   いつもお世話になっております。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=9612;id=excel
でエクセルから、アクセスへのインポート仕方を教えていただきました。
丁寧に教えてくださり、感謝しております。

マクロを実行したところ、
「各段階のOLE DBの操作でエラーが発生しました。
各OLE DBの状態の値をチェックしてください。
作業は終了しませんでした。」というエラーになってしまったので、
もう少し教えて頂けないでしょうか?

'===============================================================
Public cn As New ADODB.Connection
Public rs As New ADODB.Recordset
'===============================================================
Function open_ado(book_fullname As String) As Long
  On Error Resume Next
  link_opt = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
       "Data Source=" & book_fullname
'  ↑のよけいなストリングを省くだけ
と教えて頂いたのですが、何をすれば良いでしょうか?

教えて頂いたモジュールは、下記のように貼り付けてあります。
何か間違っているところがあるのでしょうか?
お手数をお掛けして申し訳ないのですが
よろしくお願いします。


Module7に

'==========================================================
Sub access()
  Dim sql_str As String
  If open_ado("アクセスのある場所\アクセスのファイル名.mdb") = 0 Then
    sql_str = "select * from テーブル名"

   If open_rs(sql_str) = 0 Then
     With ActiveSheet
       Set rng = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
       End With
     If rng.Row > 1 Then
       For idx = 1 To rng.Count
        If add_rs(rng.Cells(idx).Resize(1, 22)) <> 0 Then
          Exit For
          End If
        Next idx
     Else
       MsgBox "アクティブシートにデータなし"
       End If
     rs_close
     End If
    close_ado
  Else
    MsgBox "接続失敗"
    End If
End Sub

Module1に
'===============================================================
Public cn As New ADODB.Connection
Public rs As New ADODB.Recordset
'===============================================================
Function open_ado(book_fullname As String) As Long
  On Error Resume Next
  link_opt = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
       "Data Source=" & book_fullname
'  ↑のよけいなストリングを省くだけ
  cn.Open link_opt
  open_ado = Err.Number
  On Error GoTo 0
End Function
'===============================================================
Sub close_ado()
  On Error Resume Next
  cn.Close
  On Error GoTo 0
End Sub
'===============================================================
Function open_rs(sql_str As String) As Long
  On Error Resume Next
  rs_close
  rs.Open sql_str, cn, adOpenStatic, adLockOptimistic
  If Err.Number <> 0 Then
    MsgBox Error$(Err.Number)
    End If
  open_rs = Err.Number
  On Error GoTo 0
End Function
'===============================================================
Function add_rs(rng As Range) As Long
  On Error GoTo err_add_rs
  With rs
   .AddNew
   For idx = 1 To rng.Count
     .Fields(idx).Value = rng.Cells(idx).Value
'    第1フィールドをオートナンバにしたので、第2フィールドからテーブルに
'    追加
    Next idx
   .Update
   End With
  add_rs = 0
ret_add_rs:
  On Error GoTo 0
  Exit Function
err_add_rs:
  MsgBox Error$(Err.Number)
  add_rs = Err.Number
  Resume ret_add_rs
End Function
'===============================================================
Sub rs_close()
  On Error Resume Next
  rs.Close
  On Error GoTo 0
End Sub
3 hits

【9811】アクセスへエクスポートする方法 hana 03/12/17(水) 15:43 質問
【9821】Re:アクセスへエクスポートする方法 ichinose 03/12/17(水) 18:02 発言
【9836】Re:アクセスへエクスポートする方法 hana 03/12/18(木) 9:37 お礼

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