• 締切済み

ExcelからAccess2013DBを更新する時

Excel2013 vba-> Access2013 mdbファイル 問題点:以下のソースを実行すると、エラーが発生します。このエラーをなくしてアクセスデータベースのテーブルの情報の更新、新規追加、削除を行いたいです。 エラー内容:実行時エラー'3251' 現在のRecordsetは更新をサポートしていません。プロバイダーか、選択されたロックタイプの限界の可能性があります。 ソース: Sub 登録処理()   Dim Rst As adodb.Recordset   Dim SQL As String   Dim Rg As Range   Dim RgData As Range   Dim lngLastRow As Long   Dim RgDel As Range      On Error GoTo errH      Set RgData = mySh.Range("B2")   lngLastRow = RgData.End(xlDown).Row   Set RgData = mySh.Range(RgData, mySh.Range("AB" & lngLastRow))      SQL = "Select * from [会社管理テーブル]"   Call DBconection2   Set Rst = New adodb.Recordset   With Rst     .ActiveConnection = Cn     'SQL文でテーブル名と抽出条件を指定する     .Source = SQL     .CursorLocation = 3 ' クライアントサイドカーソルに変更     .Open        End With      Dim y As Long      Sheets("会社管理").Select      If Rst.EOF = False And Rst.BOF = False Then          For i = 1 To RgData.Rows.Count              If Cells(i + 1, 1).Value = "変更" Then         Rst.MoveFirst         Rst.Find "[施工会社ID]=" & RgData(i, 1).Value         If Rst.EOF Then                    Else           Rst.Fields("会社ID").Value = RgData(i, 2).Value           Rst.Fields("会社名").Value = RgData(i, 3).Value           Rst.Fields("フリガナ").Value = RgData(i, 4).Value              Rst.Update         End If         Cells(i + 1, 1).Value = ""       ElseIf Range(i, 1).Value = "削除" Then         Rst.MoveFirst                  Rst.Find "[会社ID]=" & RgData.Cells(i, 1).Value         If Rst.EOF Then                    Else           Rst.Delete         End If         Set RgDel = Rows(i + 1 & ":" & i + 1)         RgDel.Select         RgDel.Delete                ElseIf Range(i, 1).Value = "新規" Then         Rst.AddNew         Rst.Fields("会社ID").Value = RgData(i, 2).Value         Rst.Fields("会社名").Value = RgData(i, 3).Value         Rst.Fields("フリガナ").Value = RgData(i, 4).Value         Rst.Update         Cells(i + 1, 1).Value = ""       End If            Next i        End If exitH:      Rst.Close: Set Rst = Nothing   Call DBclose2   Exit Sub         errH:   MsgBox Err.Number & "(" & Err.Description & ")"   GoTo exitH    End Sub Sub DBconection2()   Set Cn = New adodb.Connection   Cn.Provider = "Microsoft.Jet.OLEDB.4.0"   Cn.Open modPublic.DBPATH    End Sub Function MakeDBconection() As adodb.Connection   Set Cn = New adodb.Connection   Cn.Provider = "Microsoft.Jet.OLEDB.4.0"   Cn.Open modPublic.DBPATH      Set MakeDBconection = Cn    End Function Sub DBclose2()   Cn.Close   Set Cn = Nothing End Sub Sub EraseContents(s_Rg As Range)   s_Rg.ClearContents    End Sub 誰か、解決方法がおわかりの方がいましたら、アドバイスをよろしくお願いします。

みんなの回答

回答No.1

>Sheets("会社管理").Select この辺で止めて debug.print Rst.locktype してみてください。 以下Access2010のヘルプより LockTypeEnum 編集時にレコードに適用されるロックの種類を表します。 定数 値 説明 adLockBatchOptimistic 4 共有的バッチ更新を示します。バッチ更新モードの場合に必要です。 adLockOptimistic 3 レコード単位の共有的ロックを示します。Update メソッドを呼び出した場合にのみ、プロバイダーは共有的ロックを使ってレコードをロックします。 adLockPessimistic 2 レコード単位の排他的ロックを示します。プロバイダーは、レコードを確実に編集するための措置を行います。通常は、編集直後にデータ ソースでレコードをロックします。 adLockReadOnly 1 読み取り専用のレコードを示します。データの変更はできません。 adLockUnspecified -1 ロックの種類を指定しません。複製の場合、複製元と同じロックの種類が適用されます。 で、 LockType プロパティ (ADO) 編集時にレコードに適用されるロックの種類を示します。 設定値と戻り値 LockTypeEnum の値を設定または取得します。既定値は adLockReadOnly です。☆★☆注目! 解説 プロバイダーが Recordset を開くときに使用するロックの種類は、LockType プロパティを使用して事前に設定します。開いている Recordset オブジェクトで使用されているロックの種類は、このプロパティを取得することで確認できます。 プロバイダーによってはすべての種類のロックをサポートしていないものもあります。要求した LockType 設定をプロバイダーがサポートしていない場合は、他の種類のロックに置き換えられます。Recordset オブジェクトで実際に使用可能なロック機能を調べるには、adUpdate と adUpdateBatch で Supports メソッドを使用します。 CursorLocation が adUseClient に設定されている場合、adLockPessimistic 設定はサポートされません。サポートされていない値を設定してもエラーにはなりませんが、サポートされる LockType のうち、最も近いロックが使用されます。 LockType プロパティは、Recordset が閉じているときは読み取り/書き込み可能で、開いているときは読み取り専用になります。 リモート データ サービスでの使用 クライアント側の Recordset オブジェクトで使う場合、LockType プロパティは adLockBatchOptimistic にのみ設定できます

関連するQ&A

  • エクセルでアクセスのクエリを更新したい

    お世話になります。 アクセスのデータをエクセルで編集する方法を勉強しています。 アクセスのクエリをエクセルで呼び出すところまで成功しました。 ところが、クエリを読み込んだ後、アクセスのクエリに戻すところで煮詰まっています。 ************************************************************** Sub btn更新_Click() Dim DelCmd As String Dim z As Long Dim i As Long Dim cn As Connection Dim rs As Recordset Set cn = New Connection cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=C:\Excel\Sample.mdb" cn.Open DelCmd = "DELETE * FROM クエリA" cn.Execute DelCmd If Range("A1").Value = "" Then z = 0 Else z = Range("A1").End(xlDown).Row End If Set rs = New Recordset rs.Open "クエリA", cn, adOpenKeyset, adLockOptimistic For i = 1 To z rs.AddNew rs!番号 = Range("A" & i).Value rs!日付 = Range("B" & i).Value rs!担当者 = Range("C" & i).Value rs!顧客名 = Range("D" & i).Value rs!内容 = Range("E" & i).Value rs.Update Next MsgBox "更新しました" '後処理 rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing End Sub *********************************************************** という構文を作ってみたのですが、 rs.Open "クエリA", cn, adOpenKeyset, adLockOptimisticのところで ストップし、SQLステートメントがただしくありません。 'DELETE'、'INSERT'、'PROCEDURE'、'SELECT'、または'UPDATE'を使用してください。というエラーになります。 持っている書籍にはこのことについて何も記述が無いので、ネット検索しながら独学で解決方法を探しているのですが、めぼしい記述に出会えず、困っています。 解決方法をご存知の方、また参考になる書籍・サイトをご存知の方、お力をお貸しください。 OS:windowsXP Excel:2003 Access:2003

  • ExcelVBA Accessにデータ書き込み

    VBAでコマンドボタンを押した際に特定のセルの値をAccessDBに入力するプログラムを作りたいのですが、上手くいきません...。 実行した際に「実行時エラー '21472179000 (80040e 14)': オートメーションエラーです。」と表示されます。 また、ステップインで実行してみるとEnd Withのところでエラーが発生します。 恐らくインサート文が間違っていると思うのですが、試行錯誤しても解決できませんでしたので教えて頂きたいです。 以下プログラムです。 Private Sub CommandButton1_Click() Dim cn As ADODB.Connection Dim cmd As ADODB.Command Dim rs As ADODB.Recordset Dim constr As String Dim strSQL1 As String Dim a As String a = Range("A1").Value Dim b As String b = Range("A2").Value Dim c As String c = Range("A3").Value constr = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=~.accdb strSQL1 = "insert into " & _ "TableName (1,2,3) " & _ "values ('" + Range("A1").Value + "','" + Range("A2").Value + "','" + Range("A3").Value + "')" Set cn = New ADODB.Connection cn.ConnectionString = constr cn.Open Set cmd = New ADODB.Command With cmd .ActiveConnection = cn .CommandText = strSQL1 .Execute End With Set cmd = Nothing Set rs = Nothing cn.Close Set cn = Nothing End Sub 以上、宜しくお願い致します。

  • ACCESSからEXCELに出力する際、時間がかかる。

    よろしくお願いします。 ACCESS VBA を使用して、既存のEXCELファイルにデータを出力しているのですが、すごく時間がかかってしまいます。件数が少ない時はそれほど気にならないのですが。時間短縮する方法を教えてください。 Sub S_ExportExcel_ADO() Dim CN As ADODB.Connection Dim rst As ADODB.Recordset Dim objExcel As Excel.Application Dim i As Integer Dim W_SQL As String On Error GoTo Err_S_ExportExcel_ADO Set objExcel = New Excel.Application objExcel.Workbooks.Open ("test.xls") objExcel.Worksheets("sheet1").Select Set CN = CurrentProject.Connection Set rst = New ADODB.Recordset W_SQL = "SELECT * FROM データ" rst.Open W_SQL, CN, adOpenKeyset, adLockReadOnly i = 1 Do Until rst.EOF objExcel.Cells(i, 4) = Trim("" & rst![データ1]) objExcel.Cells(i, 5) = Trim("" & rst![データ2]) objExcel.Cells(i, 6) = Trim("" & rst![データ3]) objExcel.Cells(i, 7) = Trim("" & rst![データ4]) objExcel.Cells(i, 9) = Trim("" & rst![データ5]) '***省略*** objExcel.Cells(i, 35) = Trim("" & rst![データ15]) objExcel.Cells(i, 36) = Trim("" & rst![データ16]) i = i + 1 rst.MoveNext Loop 'EXCEL保存 objExcel.ActiveWorkbook.Close objExcel.Quit rst.Close CN.Close Set rst = Nothing Set CN = Nothing Set objExcel = Nothing End Sub

  • VB6.0でエクセルを扱うプログラムについて

    こんにちは。VB初級者です。宜しくお願いします。 現在、VB6.0でエクセルの表を操作するようなプログラムを作っています。下に書いたプログラム(わかりにくいとは思いますが、ご教授お願いします。)で値の更新は出来たようなのですが、実際に表を開こうとすると”不正な処理が行われました”というエラーメッセージが出て開くことが出来ません。ADOオブジェクトでエクセルを扱うのがちょっとおかしい(?)のかもしれませんが、今回はEXCELオブジェクトは使わないという方針です。 自分ではどこが間違っているかわかりませんでしたので教えて頂ければと思います。宜しくお願い致します。 Private Sub Command1_Click() Dim cn As ADODB.Connection Set cn = New ADODB.Connection cn.Provider = "Microsoft.Jet.OLEDB.4.0" cn.Properties("Extended Properties") = "Excel 8.0" cn.Properties("Data Source") = "C:\VB\株価管理\株価.xls" cn.Open Dim cmd As ADODB.Command Dim mySQL As String mySQL = "update [株価$] set 高値 =10000 where 高値 = 7" Set cmd = New ADODB.Command cmd.ActiveConnection = cn cmd.CommandText = mySQL cmd.Execute Set rst = New ADODB.Recordset rst.Source = "Select * From [株価$]" rst.ActiveConnection = cn rst.CursorType = adOpenDynamic rst.Open , , , , adCmdText Do While Not rst.EOF Debug.Print rst.Fields("高値") rst.MoveNext Loop rst.Close cn.Close Set rst = Nothing Set cn = Nothing Set cmd = Nothing End Sub

  • ACCESSへの更新に関して

    以下のような記述をして、VBからACCESSのテーブルに書き込みを行おうとしています。 その際に、開発をしているVisual Basic2008のデバックモードでは、問題なくACCESSに 更新ができますが、コンパイルしてできあがった"EXE"から実行した場合、ACCESSへの更新ができません。 エラーが起こっているかと思い、updateのあるfor文にポップアップを出すような仕掛けを作り、試してみましが、 そこを通過するものの、エラーも何も起こらずに正常終了してしまいます。 何が原因でしょうか。。。教えて下さい。 環境  Windows7/ACCESS2000/VB2008/参照設定:Microsoft ActiveX Data Objects 2.8 Library   'データベースファイル名 Dim dname As String = "C:\test.mdb" 'データベースパラメータ Dim strDatbasePara As String Dim Cnn As New ADODB.Connection Dim Rst As New ADODB.Recordset strDatbasePara = "Provider=Microsoft.Jet.OLEDB.4.0;" + _ "Data Source=" + dname + ";" + _ "Jet OLEDB:Engine Type=5;" Try Cnn.Open(strDatbasePara) Rst.Open("table", Cnn, ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic) If Rst.EOF Then For jcount = 0 To icount - 1 Rst.AddNew() Rst.Fields("項目1").Value = "AAA" Rst.Update() Next End If Rst.Close() Catch ex As Exception smsg = "失敗しました。" MessageBox.Show(smsg, "更新", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) End Try Cnn = Nothing Rst = Nothing

  • エクセルVBA

    A列を基準にBC列が空白ならAの数値を入れて、A>BならB列を更新、A<CならC列を更新 A列が数値以外ならその行をスキップ、という処理をしたいのですが Option Explicit Dim A As Range, B As Range, C As Range Dim i As Long Sub test() For i = 1 To 10 Set A = Cells(i, 1) Set B = A.Offset(0, 1) Set C = A.Offset(0, 2) If IsNumeric(A) Then Else Exit Sub End If If B.Value = "" Then B.Value = A.Value If C.Value = "" Then C.Value = A.Value If A.Value > B.Value Then B.Value = A.Value If A.Value < C.Value Then C.Value = A.Value Next i End Sub とすると数値以外の行の時点で停止してしまいます。 その行を飛ばして次の行に進むにはどうしたらいいのでしょうか?

  • accessからexcelへ出力時。。。

    3つのクエリを一つのエクセルシートへ出力しようとしているのですが、 3つ目が張り付きません。なんでなんでしょうか?どなたか教えてください。 Dim dbs As Database Dim rst1 As Recordset Dim rst2 As Recordset Dim rst3 As Recordset Dim intRow As Integer Dim intCell As Integer Dim xlsx As Object Set dbs = CurrentDb Set rst1 = dbs.OpenRecordset("クエリA") Set rst2 = dbs.OpenRecordset("クエリB") Set rst3 = dbs.OpenRecordset("クエリC") Set xlsx = CreateObject("Excel.Application") 'Excelオブジェクトを生成 With xlsx .ScreenUpdating = False '画面の再描画を抑止 .Workbooks.Add '新しいブックを追加 '---"クエリA"---------------------------------------------------- intRow = 1 For intCell = 1 To rst1.Fields.Count .Cells(intRow, intCell).Value = rst1.Fields(intCell - 1).Name .Cells(intRow, intCell).Interior.ColorIndex = 15 Next intCell '各レコード出力 intRow = 2 Do Until rst1.EOF For intCell = 1 To rst1.Fields.Count .Cells(intRow, intCell).Value = rst1.Fields(intCell - 1) Next intCell intRow = intRow + 1 rst1.MoveNext Loop '集計Sum For intCell = 4 To rst1.Fields.Count .Cells(intRow + 1, intCell) = "=SUM(" & Cells(2, intCell).Address & ":" & Cells(intRow, intCell).Address & ")" Next intCell ・ ・2目のクエリはOK ・ ・ ’以下3つ目のクエリ Dim intRow3 As Integer Dim intCell3 As Integer intRow3 = intRow + 5 intCell3 = 5 For intCell3 = 5 To rst3.Fields.Count .Cells(intRow3, intCell3).Value = rst3.Fields(intCell3 - 1).Name .Cells(intRow3, intCell3).Interior.ColorIndex = 15 Next intCell3 '各レコード出力 intRow3 = intRow + 6 Do Until rst3.EOF For intCell3 = 5 To rst3.Fields.Count .Cells(intRow3, intCell3).Value = rst3.Fields(intCell3 - 1) Next intCell3 intRow3 = intRow3 + 1 rst3.MoveNext Loop '---- Dim rst3RC As Integer rst3RC = intRow + 5 + rst3.RecordCount '863 '集計Sum For intCell3 = 6 To rst3.Fields.Count - 1 .Cells(rst3RC, intCell3) = "=SUM(" & Cells(rst3RC - rst3.RecordCount, intCell3).Address & ":" & Cells(rst3RC - 1, intCell3).Address & ")" Next intCell3

  • アクセスVBA。ADO

    CSVから列を分割してテーブルにしたいかったので 下記のコードを記述しましたが、 Dim cn As ADODB.Connection Dim rs As New ADODB.Recordset Dim datacount As Long Set cn = New ADODB.Connection With cn .ConnectionString = "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\;" .Properties("Extended Properties").Value = "text;HDR=YES;" .Open End With Set rs = cn.Execute("SELECT * FROM 構成マスタ.csv") datacount = rs.Fields.Count For i = 0 To datacount strsql = "SELECT " & rs.Fields(i).Name & " INTO " & rs.Fields(i).Name & " FROM 構成マスタ.csv;" cn.Execute strsql Next i rs.Close cn.Close Set rs = Nothing Set cn = Nothing SQLを実行するところで、「日付エラー」となってしまいます。 データには特に日付等はないのでエラーになる原因がわかりません。 どなたかご教示いただけますでしょうか。

  • ADO 「Set」は使ったほうがいいのでしょうか?

    Sub test1() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = New ADODB.Connection Set rs = New ADODB.Recordse End Sub Sub test2() Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset End Sub この二つは同じ意味ですか? 「Set」は使ったほうがいいのでしょうか? よろしくお願いします。

  • VBで文書を検索するシステムを作ったのですが、検索実行のたびに表示されるレコードが増えます。

    VBで文書検索を行うシステムを作っているのですが、文字列を変えて検索するたびにMSHFlexGrid上に表示されるレコードが増えていきます。原因がわかりません。よろしくお願いします。 Private Sub Command1_Click() Dim kubun As String '文字列型 Dim mojiretsu_k As String '文字列型 Dim A As Integer ' Dim cn As New ADODB.Connection 'データベースに接続するためのコネクションオブジェクト Dim cmd As ADODB.Command Dim rst As ADODB.Recordset Dim strSQL As String Dim i As Integer If Option7 = True Then ElseIf Option8 = True Then kubun = "a" ElseIf Option9 = True Then kubun = "b" ElseIf Option10 = True Then kubun = "c" ElseIf Option11 = True Then kubun = "d" ElseIf Option12 = True Then kubun = "e" ElseIf Option13 = True Then kubun = "f" ElseIf Option14 = True Then kubun = "g" ElseIf Option15 = True Then kubun = "h" ElseIf Option16 = True Then kubun = "i" ElseIf Option17 = True Then kubun = "j" End If Set cn = New ADODB.Connection cn.ConnectionString = _ "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Persist Security Info=False;" & _ "Data Source=aaa.mdb;" & _ "Mode=Read" cn.Open Set rst = New ADODB.Recordset ' レコードソースにSQL文を指定 mojiretsu_k = Text1.Text If Option18.Value = True Then '現行文書のみ検索 If Option7.Value = True Then strSQL = "Select 資料区分,資料名称,ファイルパス From T_SHIRYO WHERE 資料名称 like'%" & mojiretsu_k & "%' and 廃止フラグ = False order by ID" Else strSQL = "Select 資料区分,資料名称,ファイルパス From T_SHIRYO WHERE 資料名称 like'%" & mojiretsu_k & "%' and 資料区分 = """ & kubun & """ and 廃止フラグ = False order by ID" End If ElseIf Option19.Value = True Then '廃止文書のみ検索 If Option7.Value = True Then strSQL = "Select 資料区分,資料名称,ファイルパス,廃止フラグ From T_SHIRYO WHERE 資料名称 like'%" & mojiretsu_k & "%' and 廃止フラグ = true order by ID" Else strSQL = "Select 資料区分,資料名称,ファイルパス,廃止フラグ From T_SHIRYO WHERE 資料名称 like'%" & mojiretsu_k & "%' and 資料区分 = """ & kubun & """ and 廃止フラグ = true order by ID" End If ElseIf Option20.Value = True Then '現行+廃止文書を検索 If Option7.Value = True Then strSQL = "Select 資料区分,資料名称,ファイルパス,廃止フラグ From T_SHIRYO WHERE 資料名称 like'%" & mojiretsu_k & "%' order by ID" Else strSQL = "Select 資料区分,資料名称,ファイルパス,廃止フラグ From T_SHIRYO WHERE 資料名称 like'%" & mojiretsu_k & "%' and 資料区分 = """ & kubun & """ order by ID" End If End If rst.Open strSQL, cn, adOpenStatic, adLockOptimistic, adCmdText i = 0 Do While Not rst.EOF With Form1.MSHFlexGrid1 .AddItem "" .TextMatrix(i, 0) = rst.Fields("資料区分") .TextMatrix(i, 1) = rst.Fields("資料名称") .TextMatrix(i, 2) = rst.Fields("ファイルパス") End With i = i + 1 rst.MoveNext Loop rst.Close cn.Close Set rst = Nothing Set cn = Nothing End Sub