• 締切済み

エクセルVBAでエラー！

エクセルでVBAを組んでいます。 Aシート・Bシートにデータがあり、それをSQLで集計し、 Cシートに出力をしたいのですが、 『リンクされているExcelのワークシートを表示するための接続が切断されました。』 というエラーが出て、解決しません。 （調べてみましたが、似たような例がなく解決には至りませんでした・・・。） どなたかご教示お願い致します。 Private Sub CommandButton1_Click() Dim dbCon As Object Dim dbCols As Object Dim dbRes As Object Dim strSQL As String Dim sh1 As Worksheet Set sh1 = Worksheets("Cシート") Set dbCon = CreateObject("ADODB.Connection") dbCon.Provider = "Microsoft.Jet.OLEDB.4.0" dbCon.Properties("Extended Properties") = "Excel 8.0" dbCon.Open ThisWorkbook.FullName strSQL = "" strSQL = strSQL & "SELECT *" strSQL = strSQL & vbCrLf & "FROM [Aシート$] LEFT JOIN [Bシート$] ON [Aシート$].NO= [Bシート$].NO" Set dbRes = CreateObject("ADODB.Recordset") dbRes.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly sh1.Range("A1").CopyFromRecordset dbRes dbRes.Close Set dbRes = Nothing dbCon.Close Set dbCon = Nothing End Sub

みんなの回答

  • mitarashi
  • ベストアンサー率59% (574/965)
回答No.1

直接の回答にはなっておりませんが、自ブックをADOで処理＝必然的に開いているブックをADOで処理となりますが、メモリリークが発生してトラブる様ですので、方針を変更された方が良いと存じます。 リンク先では、自ブックのコピーを別名保存してそちらから抽出するという回避策にも言及されています。 http://support.microsoft.com/kb/319998/ja なお、Microsoft.ACE.OLEDB.12.0プロバイダでは対策されている様です。

shinahiro
質問者

お礼

回答ありがとうございます。 お礼が遅くなり申し訳ありません。 諸事情でなるべく自ブックのみでマクロを組みたいのです。 QueryTableオブジェクトが、ADO・DAOの代わりになるのを知ったので、 それを試してみて、ダメだったらコピー参照の方法を取りたいと思います。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • ＡＤＯでアクセスからエクセルシートの件数を取得した

    ＡＤＯでアクセスからエクセルシートの件数を取得したいのですが、うまく行きません。 アクセスの標準モジュールに Sub ADO_TEST1() Const StrFileName = "D:\My Documents\検索.xls" Dim dbCon As ADODB.Connection Dim dbRes As ADODB.Recordset Dim i As Long Dim strSQL As String ' Connection生成 Set dbCon = New ADODB.Connection With dbCon .Provider = "Microsoft.Jet.OLEDB.4.0" .Properties("Extended Properties") = "Excel 8.0" .Open StrFileName End With ' SQL文作成 strSQL = "SELECT * FROM [Access接続用$];" Set dbRes = New ADODB.Recordset dbRes.Open strSQL, dbCon, adOpenDynamic, adLockOptimistic, adCmdText i = dbRes.RecordCount MsgBox "エクセルのAccess接続用シートの最終行は、" & i & "行です。" dbRes.Close: Set dbRes = Nothing dbCon.Close: Set dbCon = Nothing End Sub ************************************************************* を貼り付けて実行すると、エラーにはならないのですが-1が返ってきます。 実際の行は、200行あります。 ここで、エクセルの最終行を取得して、いづれエクセルのデータをアクセスのテーブルに転記したいのですが まずここで躓いてしまったので、 ・dbRes.RecordCountで、-1が返ってくる原因 ・エクセルの該当のシートの最終行の取得の仕方 をご教授ください。 ご回答よろしくお願いします。

  • エクセルＶＢＡでcommit,rollback

    エクセルＶＢＡでcommit,rollback 初めて質問させていただきます。 エクセルＶＢＡを一人で学習しています。 仕事で使ったことも、教えてもらったこともほとんどありませんのでほぼ初心者です。 今、エクセルファイルを二つ使って、一つをデータベースに、もう一つでそのデータベースを 利用するようなプログラムを書いています。 それで、２つの関連するテーブル（シート）を同時に変更(update)する必要があるのですが、 何らかのエラーが起きてしまったときのことを考えて、トランザクションを利用 出来たらと思っています。 いろいろググってアクセス用のコードを見つけたので、それを元に下のようなプログラムを 書いて試してみたのですが、ロールバックが効かずに更新されてしまいます。 '******** 定数 *********** Const cnsProvider = "Microsoft.Jet.OLEDB.4.0" Const cnsExtProp = "Extended Properties" Const cnsExcel = "Excel 8.0" Const cnsDBName = "SAMPLE_DB.xls" Const cnsYen = "\" '******** プログラム *********** Sub ADO_update_test() Dim dbCon As ADODB.Connection Dim strSQL As String ' -- Connection生成 -- Set dbCon = New ADODB.Connection With dbCon .Provider = cnsProvider .Properties(cnsExtProp) = cnsExcel .Open ThisWorkbook.Path & cnsYen & cnsDBName End With ' -- トランザクション開始 -- dbCon.BeginTrans ' -- sql作成 -- strSQL = "update [Sheet1$] set 金額 = 300 where ID = '001';" ' -- sqlを流す -- dbCon.Execute (strSQL) ' -- rollback -- dbCon.RollbackTrans ' -- クローズ・コネクション解放 -- dbCon.Close: Set dbCon = Nothing End Sub １、まずこの様なことが可能なのかどうか ２、出来るとしたらどのようにすればいいのか（間違っている点を指摘してください） 以上の２点についてお答えをいただけるとありがたいです。 よろしくお願いいたします。

  • 【ADO】mdbのレコードの条件検索

    日付+特定のレコードの値が優のレコードをExcelのセルに表示するマクロを組んでいます。 Option Explicit Const cnsADO_CONNECT1 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" Dim dbCon As New ADODB.Connection Dim dbRes As New ADODB.Recordset Dim dbCols As ADODB.Fields Dim strStartData As String, strEndData As String Dim strsql As String Dim Gyo As Long Public Sub testテスト() 'テスト用 strStartData = 20120401 strEndData = 20130331 '接続mdb名 FileName = \\～～テスト.mdb dbCon.Open cnsADO_CONNECT1 & FileName strsql = "SELECT * FROM テーブル名 WHERE 日付 BETWEEN '" & strStartData & "' AND '" & strEndData & "' ORDER BY 日付" 　 dbRes.Open strsql, dbCon, adOpenKeyset, adLockReadOnly strsql = Replace(strsql, "strEndData", strEndData) strsql = Replace(strsql, "strStartData", strStartData) dbRes.Filter = "座学判定　 = '優' or　WHERE 実技判定　 = '優' " 　 dbRes.Open strsql, dbCon, adOpenKeyset, adLockReadOnly　←ここでエラー Gyo = 1 Rows("2:65536").ClearContents dbRes.MoveFirst Do Until dbRes.EOF ' 行の変数を加算し必要項目を選択してセルにセット Gyo = Gyo + 1 Set dbCols = dbRes.Fields 'DT_P_点検Tblテーブルよりを抜き出す Cells(Gyo, 1).Value = dbCols("ID").Value Cells(Gyo, 2).Value = dbCols("日付").Value Cells(Gyo, 3).Value = dbCols("座学判定").Value Cells(Gyo, 4).Value = dbCols("実技判定").Value ' 次のレコードに移る dbRes.MoveNext Loop ' レコードセット、データベースを閉じる dbRes.Close Set dbRes = Nothing dbCon.Close Set dbCon = Nothing End Sub dbRes.Open strsql, dbCon, adOpenKeyset, adLockReadOnly　の部分でエラーになってしまいます。 「CommandオブジェクトのCommandTextが設定されていません」と表示されます。 dbRes.Filter = "座学判定　 = '優' or　WHERE 実技判定　 = '優' " 　 ここの部分が無ければ、指定の期間のデータを抽出してくれています。 指定期間　+　特定の部分がTrueの場合の抜き出しをしたいのですが、どこかで指定が不足しているのでしょうか？

  • エクセル VBA SQL　開始行の指定

    namatyu MC285Pさんの質問からの解答を利用させていただいて、会社の履歴表を作成しましたが、訳あって、（資材受け入れシート）側の開始行をA1からA2に変えた所、「パラメータがすくなすぎます。１４を指定してください」と出てしまいます。 Sheets("資材受け入れシート").Range("A1:D1").Copyを Sheets("資材受け入れシート").Range("A2:D2").Copyに変えても解決しません… SQL文が勉強不足で、変更場所が分かりません 　 1　　　2　　 3　 4 　受入日　品名　 Lot　 数量 　　7/7 　　A　 BNR32　 10 　　7/8 　　A　 BNR32　 5 　　7/10 　 B　 SW200　 2 　　7/7 　　B　 AE860　 4 　　7/8 　　B　 SW200　 12 　　7/9 　　C　 GD300　 10 　　7/7 　　C　 GD300　 1 　　7/7 　　C　 DC200　 7 Sub test() 　　Dim strSql As String 　　Dim cnXL As Object 　　Dim rsXL As Object 　　Const adOpenForwardOnly = 0 　　 　　 　　Sheets("資材受け入れシート").Range("A1:D1").Copy 　　Sheets("資材受け入れシート").Paste Destination:=Worksheets("Sheet2").Range("A1:D1") 　　Application.CutCopyMode = False 　　 　　Set cnXL = CreateObject("ADODB.Connection") 　　Set rsXL = CreateObject("ADODB.Recordset") 　　With cnXL 　　　　.Provider = "MSDASQL" 　　　　.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _ 　　　　"DBQ=" & ThisWorkbook.FullName & "; ReadOnly=True;" 　　　　.Open 　　End With 　　strSql = "select max(受入日) as 日付,品名,Lot,sum(数量) as 合計" _ 　　　　　　　　& " from [資材受け入れシート$]" _ 　　　　　　　　& " group by 品名,Lot order by max(受入日),品名,Lot" 　　 　　Debug.Print strSql 　　rsXL.Open strSql, cnXL, adOpenForwardOnly 　　Worksheets("sheet2").Cells(2, 1).CopyFromRecordset rsXL 　　Worksheets("sheet2").Columns("A:A").NumberFormatLocal = "m/d" 　　 　　rsXL.Close: Set rsXL = Nothing 　　cnXL.Close: Set cnXL = Nothing 　　MsgBox "Sheet2に出力しました" End Sub 色々、試したのですが、分かりません… すいませんが、どたたか教えてください、お願いします。

  • ＤＢから取得したオブジェクトの受け渡し方法

    はじめましてＶＢ初心者でわけが分からなくなっています。ＤＢをクローズした後に取得したレコードセットを他の関数に渡すにはどうしたらよいでしょうか？おそらく、そんなのcloseせずにやればいいと思うかもしれませんが、可能かどうかがわかりません。どうか教えてくださいよろしくお願い致します。 下記のコードにて行ってます。Set rs = cn.Execute(strSQL)で取得しています。rsをＤＢを閉じた後も他の関数に渡せるようにしたい訳です。m(..)m Dim cn As Object Dim rs As Object Private Sub getData() Dim strSQL As String Set cn = CreateObject("ADODB.Connection") cn.Open "省略" strSQL = "SELECT * FROM swan" Set rs = cn.Execute(strSQL) Set rs = nothing Set cn.close Set cn = nothing End Sub

  • Excelファイルのデータをテーブルへインポートできない

    お世話になります。 このコードは「ここが知りたかった！ACCESS　VBA　500の技」 の452ページに載っているものです。 エラーで動作しません。 私には分からないので教えて下さい。 Sub ExceltoMDBTable() Dim adoExcelCon As New ADODB.Connection Dim adoSheetRst As ADODB.Recordset Dim strSQL As String Dim adoMdbCon As New ADODB.Connection adoExcelCon.Open "Driver={Microsoft Excel Driver (*.xls)};" & _ "DBQ=c:\temp\test.xls;ReadOnly=0;" Set adoMdbCon = Application.CurrentProject.Connection Set adoSheetRst = adoExcelCon.Execute("select distinct 得意先コード,得意先名 from [Sheet1$]") Do Until adoSheetRst.EOF = True strSQL = "" strSQL = strSQL & "insert into test" strSQL = strSQL & " (得意先コード" strSQL = strSQL & " ,得意先名" strSQL = strSQL & " ,登録日 )" strSQL = strSQL & "Values ( '" & adoSheetRst("得意先コード") & "'" strSQL = strSQL & " ,'" & adoSheetRst("得意先名") & "'" strSQL = strSQL & " ,#" & Date & "# )" adoMdbCon.Execute (strSQL) adoSheeyRst.MoveNext Loop adoSheetRst.Close adoMdbCon.Close adoExcelCon.Close Set adoSheetRst = Nothing Set adoMdbCon = Nothing Set adoExcelCon = Nothing End Sub

  • ADOでエクセルファイルの件数を取得したい

    エクセルvbaでadoを使って他ファイルの件数を取得することは可能でしょうか？ もともと件数を取得したいファイルは共有フォルダに入っていて、 開くのにすごく時間がかかるのでADOで試みたいのです。 しかしうまくいきません。 当方の環境は Win7、エクセル２０１０です。 http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_130_090.html を参考にしたのですが、 Const cnsProvider = "Microsoft.Jet.OLEDB.4.0" Const cnsExtProp = "Extended Properties" Const cnsExcel = "Excel 8.0" Const cnsDBName = "D:\Book1.xlsx" 'ローカルでテスト Sub ADO_WS_TEST1() Dim dbCon As ADODB.Connection Dim dbRes As ADODB.Recordset Dim GYO As Long, COL As Long Dim strSQL As String ' Connection生成 Set dbCon = New ADODB.Connection With dbCon .Provider = cnsProvider .Properties(cnsExtProp) = cnsExcel .Open cnsDBName End With の .Open cnsDBNameの部分で、 実行時エラー-2147467259 外部テーブルのフォーマットが正しくありません。 となります。 Excel 8.0が原因なのでしょうか？ オフィス２０１０でもExcel 8.0でいいのでしょうか？ ココがうまく通ったら、 "SELECT * FROM [Sheet1$]"の部分をCOUNTにして 件数が取得できるかなー と思うのです。 リンク先を読むと、adoでやってもあまり早くはならなそうですが一応やってみたいのです。 よろしくお願いします。

  • Accessでのデータベースの使用(VBA)

    Private Sub 実行_Click() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim StSQL As String Set cn = CurrentProject.Connection Set rs = New ADODB.Recordset strSQL = "INSERT INTO マスタ(コード) VALUES(コード) ;" rs.Open strSQL, cn, , adLockOptimistic '//前のコード（エラーになりました。） ' rs.Close 'cn.Close 'Set rs = Nothing 'Set cn = Nothing Set rs = Nothing: Close Set cn = Nothing: Close Accessを使用したvbaのコードの書き方について教えてほしいです。毎度Access の質問ばかりしてすみません。以下のコードはADOを使用してマスタというテーブルを読み込んで最後にrs.CloseでRecordSetを開放しようとしたのですが「オブジェクトが閉じている場合は、操作は許可されません。」というエラーメッセージが出てしまい原因がわかりませんでした。Openしていて開いているはずなのにエラーが出てしまい、 Set rs = Nothing: Closeに変えたら治りました。何故rs.Closeではエラーが出てしまったのでしょうか。 もう一つお聞きしたいです。 strSQL = "INSERT INTO マスタ(コード) VALUES(コード) ;"でコードという名前を付けたテキストボックスの値をマスタテーブルのコードの列に追加したいのですがテキストボックスの値の取り方が分かりません。（コード.Value）とやってみてもだめでした。どうやったらSQL文でテキストボックスの値をテーブルに追加できるんでしょうか。

  • excelからAccessのDBを更新でエラー

    excel2016 excelでaccessへのデータ登録はできたのですが、登録したaccessデータの更新でエラーが発生します。 構成 MENUシートのD4に表示されたシート名でaccessへ登録を実施。 このシート名はaccessのテーブル名になっている。 accesssのファイル名は Machine.accdbでサーバに登録している（サーバ名の実名は伏せて***にしてます） accessファイルは単独で編集できない様にパスワード付きでexcelからのみ追加更新を可能にする。 excelの題目 A1:ref_serial C1:result1 D1:result2 他にも題目ありますが、関係する部分とします。 データは A2セルに数字4桁 C2セル整数2桁小数点3桁 D2セル整数2桁小数点3桁 accessで ref_serial、オートナンバー、長整数型 result1,数値型、単精度浮動小数点型 result2,数値型、単精度浮動小数点型 としてます addのマクロで追加した内容を、そのままrenewのマクロ実行すると 実行時エラー424 オブジェクトが必要です とのポップアップエラーが発生します。 エラーが発生するのは strSQL = _ "UPDATE '" & sheet_name & "' " & _ "SET " & _ ws.Worksheets(sheet_name).Range("C1").Value & "=" & ws.Worksheets(sheet_name).Range("C2").Value & "," & _ ws.Worksheets(sheet_name).Range("D1").Value & "=" & ws.RWorksheets(sheet_name).ange("D2").Value & "," & _ "WHERE ref_serial =" & ws.Worksheets(sheet_name).Range("A2").Value の部分。 web等でも調べたのですが、何が悪いのかわからず、このエラーが出ない様に修正いただきたく、よろしくお願いします。 データ登録のマクロ Sub add() Dim strFileName As String strFileName = "Machine.accdb" Dim DBpath As String DBpath = "***" 'accdbファイルパス Dim password As String password = "AAAA" 'InputBox("パスワードを入力してください") If password = "" Then Exit Sub Dim adoCn As Object 'ADOコネクションオブジェクト Set adoCn = CreateObject("ADODB.Connection") 'ADOコネクションオブジェクトを作成 adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBpath & "\" & strFileName & ";" & _ "Jet OLEDB:Database Password=" & password & ";" 'Accessファイルに接続 Dim adoRS As Object 'ADOレコードセットオブジェクト Set adoRS = CreateObject("ADODB.Recordset") 'ADOレコードセットオブジェクトを作成 Dim day As String day = Worksheets("MENU").Cells(1, 2) Dim sheet_name As String sheet_name = Worksheets("MENU").Cells(4, 4) With adoRS .Open sheet_name, adoCn, adOpenKeyset, adLockOptimistic 'レコードセットを開く" Dim adoCON As New ADODB.Connection .AddNew !ref_serial = Worksheets(sheet_name).Cells(2, 1) !result1 = Worksheets(sheet_name).Cells(2, 3) !result2 = Worksheets(sheet_name).Cells(2, 4) !result_update = Worksheets("MENU").Cells(1, 2) .update .Close 'レコードセットのクローズ End With adoCn.Close 'コネクションのクローズ Set writeSht = Nothing Set adoRS = Nothing Set adoCON = Nothing End Sub 更新のマクロ Sub renew() Dim strFileName As String strFileName = "Machine.accdb" Dim DBpath As String DBpath = "***" 'accdbファイルパス Dim password As String password = "AAAA" 'InputBox("パスワードを入力してください") If password = "" Then Exit Sub Dim adoCn As Object 'ADOコネクションオブジェクト Set adoCn = CreateObject("ADODB.Connection") 'ADOコネクションオブジェクトを作成 adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBpath & "\" & strFileName & ";" & _ "Jet OLEDB:Database Password=" & password & ";" 'Accessファイルに接続 Dim day As String day = Worksheets("MENU").Cells(1, 2) Dim sheet_name As String sheet_name = Worksheets("MENU").Cells(4, 4) Dim strSQL As String strSQL = _ "UPDATE '" & sheet_name & "' " & _ "SET " & _ ws.Worksheets(sheet_name).Range("C1").Value & "=" & ws.Worksheets(sheet_name).Range("C2").Value & "," & _ ws.Worksheets(sheet_name).Range("D1").Value & "=" & ws.RWorksheets(sheet_name).ange("D2").Value & "," & _ "WHERE ref_serial =" & ws.Worksheets(sheet_name).Range("A2").Value adoCn.Execute strSQL 'SQLを実行 adoCn.Close 'コネクションのクローズ Set adoCn = Nothing 'オブジェクトの破棄 End Sub

  • VB６．０でエクセルを扱うプログラムについて

    こんにちは。VB初級者です。宜しくお願いします。 現在、VB６．０でエクセルの表を操作するようなプログラムを作っています。下に書いたプログラム(わかりにくいとは思いますが、ご教授お願いします。）で値の更新は出来たようなのですが、実際に表を開こうとすると”不正な処理が行われました”というエラーメッセージが出て開くことが出来ません。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

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する