• ベストアンサー

ExcelからAccessを操作中のウエイト

AccessのデータをExcelからSQL文を使って取り出しています。 複数のレコードセットを2次元配列に取り組むために With My_RecSet On Error Resume Next .Open MySQL, My_DB On Error GoTo 0 Application.Wait Now + TimeValue("00:00:01") On Error GoTo RsCloseHdl If .EOF And .BOF Then '該当するレコードセットが一つもない場合 SQL_ext = -1  ←Function名 Exit Function Else SQL_ext = .GetRows End If としています。 私のパソコンの性能の関係かもしれませんが、ウエイトを入れないとたまに、レコードセットが1つ以上あるのにも関わらず.EOF And .BOF で引っ掛かります。1秒以下のウエイトの入れ方を教えて頂けませんか? また、たまに、.Closeさせているにも関わらす、.Open MySQL, My_DBで、すでに開いているものに開けませんとエラーがでるので、やむなく、On Error Resume Nextとしています。限られた情報の提供となりますが、わかる範囲で教えて頂けないでしょうか? よろしくお願いいたします。

質問者が選んだベストアンサー

  • ベストアンサー
  • KenKen_SP
  • ベストアンサー率62% (785/1258)
回答No.1

> 1秒以下のウエイトの入れ方を教えて頂けませんか? Sleep API が一番簡単かな。モジュールの先頭で以下のように宣言 しておき、ミリ秒(1秒=1000ミリ秒)単位でウェイトをかけられ ます。 Declare Sub Sleep Lib "kernel32.dll" ( _     ByVal dwMilliseconds As Long) Sub Test()   ' 処理~   Sleep (500) ' 500ミリ秒   ' 処理~ End Sub

vba_minarai
質問者

お礼

Loop処理の中でウエイトを使っていたので、実際に処理する時間の3倍ぐらいがウエイトで占められていましたので大変助かります。 早速使わせて頂きます。 ありがとうございます。

その他の回答 (1)

  • nicotinism
  • ベストアンサー率70% (1019/1452)
回答No.2

だめもとで・・ >レコードセットが1つ以上あるのにも関わらず.EOF And .BOF で引っ掛かります Dcount で判断させてから、あれば配列に代入とか? >Closeさせているにも関わらず Closeの処理を通ってないとか、.Close : Set My_RecSet = Nothing としてみるとか カーソルタイプをadOpenDynamic などに変えてみるとか

vba_minarai
質問者

お礼

回答ありがとうございます。 Accessは、初心者なのでいろいろと勉強していきたいと思います。 教えて頂いた点についても調べてみます。 本当にありがとうございました。

関連するQ&A

  • VBでAccessにSQL文を実行して値を取り出す

    下記のソースは、 UserIDとPasswordをDBと照らし合わせて、 そのUserが存在すればTrue、存在しなければFalse を返すというプログラムです。 しかし初めてDBに接続し、まったく右も左も分からない 状況なので処理的におかしな点を教えていただけないでしょうか。 またDB接続からSQL実行までの簡単な流れを教えていただけると助かります。 adoRs = ADODB.Recordset adoCn = ADODB.Connection adoCd = ADODB.Command Login.txtName.Text = 比較するユーザー名 Login.txtPass.Text = 比較するパスワード です。その他わかりにくい点があったら質問を お願いします。 Private Function Func_UserSerch() As Boolean Func_UserSerch = False On Error GoTo UserSerchError 'レコードセットの取得 With adoRs .ActiveConnection = adoCn .Source = "user" .CursorType = adOpenStatic .LockType = adOpenForwardOnly .Properties("IRowsetIdentity") = True .Open End With MySQL = "SELECT * FROM user " & _ "WHERE UserID = " & Login.txtName.Text & _ "AND Password = " & Login.txtPass.Text & ";" 'SQLの実行 With adoCd .ActiveConnection = adoCn .CommandType = adCmdStoreProc .CommandText = MySQL .Execute End With If adoRs.EOF = True And adoRs.BOF = True Then Func_UserSerch = False Else Func_UserSerch = True End If UserSerchError: MsgBox "SQL実行中にエラーが発生しました" End Function

  • ACCESSを活用して商品変動を捉えたい(5再再)

    http://okwave.jp/qa/q8782706.html 上記について標準モジュールも作成して、先のクエリーを実行しましたが、 その際に !コンパイル エラー: ユーザー定義型は定義されていません。 と出ます。 5行目の rst As ADODB.Recordset 箇所が反転されています。 一回でできるのは魅力なのですが、本当に実装できるのでしょうか。 (クエリーはたしかに保存できました) Public Function DBLookup(ByVal strQuerySQL As String, _              Optional ByVal ReturnValue = Null) As Variant On Error GoTo Err_DBLookup   Dim DataValue   Dim rst     As ADODB.Recordset   Set rst = New ADODB.Recordset   With rst     .Open strQuerySQL, _        CurrentProject.Connection, _        adOpenStatic, _        adLockReadOnly     If Not .BOF Then       .MoveFirst       DataValue = .Fields(0)     End If   End With Exit_DBLookup: On Error Resume Next   rst.Close   Set rst = Nothing   DBLookup = IIf(Len(DataValue & ""), DataValue, ReturnValue)   Exit Function Err_DBLookup:   MsgBox "SELECT 文の実行時にエラーが発生しました。(DBLookup)" & Chr$(13) & Chr$(13) & _       "・Err.Description=" & Err.Description & Chr$(13) & _       "・SQL Text=" & strQuerySQL, _       vbExclamation, " 関数エラーメッセージ"   Resume Exit_DBLookup End Function Public Function DBLookup(ByVal strQuerySQL As String, _              Optional ByVal ReturnValue = Null) As Variant On Error GoTo Err_DBLookup   Dim DataValue   Dim rst     As ADODB.Recordset   Set rst = New ADODB.Recordset   With rst     .Open strQuerySQL, _        CurrentProject.Connection, _        adOpenStatic, _        adLockReadOnly     If Not .BOF Then       .MoveFirst       DataValue = .Fields(0)     End If   End With Exit_DBLookup: On Error Resume Next   rst.Close   Set rst = Nothing   DBLookup = IIf(Len(DataValue & ""), DataValue, ReturnValue)   Exit Function Err_DBLookup:   MsgBox "SELECT 文の実行時にエラーが発生しました。(DBLookup)" & Chr$(13) & Chr$(13) & _       "・Err.Description=" & Err.Description & Chr$(13) & _       "・SQL Text=" & strQuerySQL, _       vbExclamation, " 関数エラーメッセージ"   Resume Exit_DBLookup End Function

  • アクセス テーブルデータ他のテーブルにコピーVBA

    win10 access365のmdbファイルにおいて table1のフィールド1がID 数値型 長整数型 値要求あり 重複あり フィールド2が氏名 短いテキスト型 225 値要求なし 重複あり  table2;フィールド1がID 数値型 長整数型 値要求あり 重複あり フィールド2が氏名 短いテキスト型 225 値要求なし 重複あり  上記に置いて table2の新しいデータとして table1のデータをコピーしたい、 ただしtable1には レコードは1行だけとします (table1にレコードが複数行ある場合の最新レコードだけtable2にコピーも出来れば知りたいです) アクセス付属の更新クエリーでは、どうも うまくいきません sqlにおいて UPDATE table1, table2 SET table2.ID = [table1]![ID], table2.氏名 = [table1]![氏名]; 上記動作しません Function table1から2() Dim db As DAO.Database Dim rst As Recordset Dim TB As Table Dim Rdset As Recordset On Error Resume Next Set db = DBEngine(0)(0) Set Rdset = db.OpenRecordset("table2", DB_OPEN_TABLE) Rdset.AddNew Rdset![ID] = Table![table1]![ID] Rdset![氏名] = Table![table1]![氏名] Rdset.Update End Function table1, table2を それぞれ 同名のフォームを作り Function table1から2() Dim db As DAO.Database Dim rst As Recordset Dim fm As Form Dim Rdset As Recordset On Error Resume Next Set db = DBEngine(0)(0) Set fm = Forms![table1] If Rdset.BOF Then Exit Function Else Set Rdset = db.OpenRecordset("table2", DB_OPEN_TABLE) Rdset.AddNew Rdset![ID] = Forms![table1]![ID] Rdset![氏名] = Forms![table1]![氏名] Rdset.Update End If End Function いずれも table2のデータ更新が なされていません すみません 宜しくお願い致します

  • BOF と EOF のいずれかが True になっ

    VBAのADOで 「BOF と EOF のいずれかが True になっているか、 または現在のレコードが削除されています。 要求された操作には、現在のレコードが必要です」 のエラーになる時に 「BOF と EOF のいずれかが True になっている」 なのか 「現在のレコードが削除されています」 なのか どちらのエラーなのか調べる方法はありますか?

  • VBScriptでレコードがない場合エラーになる

    VBScriptを使ってHTAを作っています。 ちょっと疑問なのですが、以下のようなコードでレコードがないと 「カレントレコードがありません」というエラーになってしまいます。 txtSQL = "SELECT * FROM test" Set rs = db.OpenRecordSet(txtSQL) ' dbはDAOのデータベースオブジェクト プロシージャで On Error Resume Nextすればエラーになりませんが、 そうなるとありえる全エラーをErrオブジェクトを使ってcatchしないと いけなくなり面倒です。 On Error Resume Nextなしで、ありえるエラーの中で特定のものを (今回は「カレントレコードがない」エラーです)エラーでなくす ことはできないのでしょうか? または プロシージャの中で On Error Resume Nextを使って、 プロシージャの途中でまたエラーで停止するような命令はない のでしょうか? 教えていただけると幸いです。

  • 命令文が長文になります 行を分割入力出来ますか

    何度もお世話になります。 QNo.3140739 の続きです。 以下はレコード挿入のルーチンです Function 介護メモ挿入() on Error GoTo レコード挿入_Err DoCmd.SetWarnings False DoCmd.RunSQL "insert into 介護メモ (利用者,介護日,身体単位,生活単位,開始時刻,年月) values (利用者 , 日付 , 身体単位 , 生活単位 , 開始時刻,年月)", -1 DoCmd.SetWarnings True レコード挿入_Exit: Exit Function レコード挿入_Err: MsgBox Error$ Resume レコード挿入_Exit End Function これで実行は出来たのですが、文中の介護メモは実際にはフィールド数が38ある介護記録というテーブルです。長い命令文になります。 画面内に表示できるように命令文の分割をしたいのですが 以下のように変更したのですが「クエリ式'11:00:00'の構文エラー」と時刻項目は文字列扱いのようです 同様に日付項目は分数式扱い? Function 介護メモ挿入() DIM SQL文 as String SQL文 = "insert into 介護メモ (利用者,介護日,身体単位,生活単位,開始時刻,年月) values (" SQL文 = SQL文 & """" & 利用者 & """," & 日付 & "," & 身体単位 & "," & 生活単位 & "," & 開始時刻 SQL文 = SQL文 & "," & 年月 & ")" On Error GoTo レコード挿入_Err DoCmd.SetWarnings False DoCmd.RunSQL SQL文, -1 DoCmd.SetWarnings True レコード挿入_Exit: Exit Function レコード挿入_Err: MsgBox Error$ Resume レコード挿入_Exit End Function

  • PHPからMySQLに接続はできるが、Sql操作ができない

    PHPからMySQLを使おうとしているのですが、 SQLクエリでの操作に対する反応がなく、困っています。 mysql_select_db()でtrueが返ってきているので、 DBにはアクセス出来ているようなのですが、 mysql_query()を実行しても何も返らず、エラーも出ません。 SQLに間違いはなく、あってもエラーがでるはずだったと思うのですが… 何かお分かりのことが御座いましたら、ご協力お願いいたします。

    • ベストアンサー
    • MySQL
  • ExcelからAccessの関数を使用したい

    EXCELのVBAよりACCESS上のモジュールで定義された関数(Function) を使用したいのですが、可能でしょうか? EXCELから引数はACCESSに対しては、引数を付けて実行できるのですが、ACCESSからEXCELへの返却値の受け取り方が分からなくて困っています。(環境はOFFICE2000です。他のバージョンなら可能?) ■EXCEL Set objACCESS = CreateObject("Access.Application") objACCESS.OpenCurrentDatabase ActiveWorkbook.Path & "\database.mdb" objACCESS.Run "UserFunction", 123 Set objACCESS = Nothing #### UserFunctionの結果が欲しい ### ■ACCESS Public Function UserFunction(inValue) W_SQL = "SELECT data FROM table WHERE key = " & inValue Set DB = CurrentDb Set RST = DB.OpenRecordset(W_SQL) If RST.EOF Then RST.Close UserFunction = -1 Else UserFunction = RST("data") RST.Close End If End Sub

  • Excel VBA Accessでデータ取り込み

    Excel VBA、Access VBAについてお教え下さい。 「My_Excel.xlsm」というファイルがあります。このファイルにはボタンが1つあります。 このボタンを押すことにより、「Imp_Excel.xlsx」というファイルを取り込みたいと思います。 取り込み先ですが、「My_Excel.xlsm」に取込むのではなく、Accessの「My_Access.accdb」の「T_MyTable」というテーブルに取り込みたいと思っています。 Accessから直に「Imp_Excel.xlsx」をインポートするには、TransferSpreadsheetを用いれば比較的簡単にデータをAccessに取り込むことができるのですが、「My_Excel.xlsm」をまたいでAccessに取り込みたいので、TransferSpreadsheetは使えません。 やり方としては、 My_Excel.xlsxを開く。 レコードセット取得。 レコードセットがEOFになるまでまわして、SQLのINSERT、またはAddNewメソッドを使用して1件1件挿入していくしか方法はないでしょうか? 今のところ、私が思い浮かぶのは上記の方法なのですが、何かもっと簡単にやれるような方法はあるでしょうか?よろしくお願いします。

  • レコードが存在しなかった場合

    教えてください。 Vbscript初心者です。 SQLでデータを取得した後の構文で以下のような記述があります。 もしレコードが存在しなかった場合に Response.write(”レコードが存在しません")と表示したいです。 IIf Rs.RecordCount=0 Then Response.write("レコードが存在しません") End If のような書き方をどこかに入れようとしているのですが、以下のようなメッセージが表示されてしまいます。どのように書けば宜しいでしょうか? ADODB.Field エラー '800a0bcd' BOF と EOF のいずれかが True になっているか、または現在のレコードが削除されています。要求された操作には、現在のレコードが必要です。 よろしくお願い致します。 **************************** SQL文や接続の記述 <% Do While not Rs.EOF = True  Response.Write・・・   Rs.MoveNext Loop Rs.Close Set Rs = Nothing Con.Close Set Con = Nothing %> **************************

専門家に質問してみよう