Excel VBA質問箱 IV

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

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


12573 / 13644 ツリー ←次へ | 前へ→

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

【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

【9821】Re:アクセスへエクスポートする方法
発言  ichinose  - 03/12/17(水) 18:02 -

引用なし
パスワード
   ▼hana さん:
こんばんは。

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

確定は、できませんが、
たぶん、add_rs Functionでのエラーなのでしょうね?
(あっ、原因が違うかもしれないので、各Functionで
if err.number<>0 then
  msgbox error$(err.number) & "function名"
  end if
のようなコードを付加して確認してみて下さい)
又、一度、マクロを作成したExcelブックを立ち上げなおして再度
実行してみて下さい。
最初に他のエラーメッセージが表示されませんか?

考えられるのは、
・テーブルの型とセルの型が一致していない場合
・テーブルは空白を許容していないのに空白がある場合
・もし、Networkで他のPCのMdbファイルに接続している場合、
 共有が読取専用になっている

etc
ですが・・・。

確認してみて下さい。

【9836】Re:アクセスへエクスポートする方法
お礼  hana  - 03/12/18(木) 9:37 -

引用なし
パスワード
   ▼ichinose さん:ご指摘ありがとうございました。
テーブルのフィールドを直したところ、
エクスポートできました!!
今まで毎日、オペレーターの人数分、
コピー&ペーストしていたのですが、
これで解決できそうです。
とっても感謝しています。
ありがとうございました!!

>考えられるのは、
>・テーブルの型とセルの型が一致していない場合
>・テーブルは空白を許容していないのに空白がある場合
>・もし、Networkで他のPCのMdbファイルに接続している場合、
> 共有が読取専用になっている

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