[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『CopyFromRecordsetメソッドに失敗しました』（やたろう）
処理内容は、
1．計算式が書かれた提出用資料用6シートと、Accessデータを貼り付ける為の作業用8シートのExcelを開く
2．Accessからクエリの結果をExcelの作業用シート全件貼り付け、レコード件数、
提出用資料のシートの方の行数を増やす
3．同じような処理を8回繰り返す
4．Excelを再計算をさせ、最後に作業用の列やシートを削除し保存する
Accessは起動すると自動でプログラムが実行されるようになっており、
そのまま実行する分には正常終了します。（データも正しくExcelにはりつきます）
ただ、デバッグをしようとAccessのステップイン(F8)で途中まで実行して残りを一気に実行した場合(F5)などに
「CopyFromRecordsetメソッドに失敗しました。：Rangeオブジェクト」と表示され処理が中断してしまう場合があります。低い確率で処理がうまくいくときもあります。
中断したときは大体CopyFromRecordsetの処理が5回目以降のようです。
4回目までの書き方と同じなので、何がいけないのかがまったくわからず困っています。
（以下のコードは、CopyRecordsetを2回分のみ記載しました）
どなたかご教授いただけると大変助かります。
よろしくお願いいたします。
Function Out_toExcel(ByRef mdb As Database)
Dim RS As Recordset
Dim StrPath As String, FileNM As String
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim wk_ws As Excel.Worksheet
Dim ws(1 To 6) As Excel.Worksheet
StrPath = CurrentProject.Path
FileNM = "\Template\実績集計.xlsx"
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(StrPath & FileNM)
xlApp.Application.Visible = True
xlApp.ScreenUpdating = True
xlApp.Application.DisplayAlerts = False
Set ws(1) = xlBook.Sheets("明細")
Set ws(2) = xlBook.Sheets("店別明細")
Set ws(3) = xlBook.Sheets("【当週】サマリ")
Set ws(4) = xlBook.Sheets("【月次】サマリ")
Set ws(5) = xlBook.Sheets("【当週】商品別")
Set ws(6) = xlBook.Sheets("【月次】商品別")
'<<新商品実績>>
Set wk_ws = xlBook.Sheets("DB?D")
Set RS = mdb.OpenRecordset("SELECT Temp_DB?D.* FROM Temp_DB?D")
If RS.EOF Then
ws(2).Range("34:36").Delete
ws(3).Range("35:38").Delete
ws(4).Range("35:38").Delete
ws(5).Range("36:39").Delete
ws(6).Range("36:39").Delete
Else
wk_ws.Range("A2").CopyFromRecordset RS '集計したデータを「DB?D」シートへ貼り付け
Maxrow = wk_ws.Cells(wk_ws.Rows.Count, 6).End(xlUp).Row - 1 'レコード件数を取得
Select Case Maxrow 'レコード件数分の行調整
Case 1
ws(2).Range("35:36").Delete
ws(3).Range("37:38").Delete
ws(4).Range("37:38").Delete
ws(5).Range("38:39").Delete
ws(6).Range("38:39").Delete
Case 2
ws(2).Range("36:36").Delete
ws(3).Range("38:38").Delete
ws(4).Range("38:38").Delete
ws(5).Range("39:39").Delete
ws(6).Range("39:39").Delete
Case Is >= 4
Call Insert_Row(xlApp, ws(2), Maxrow, 34)
Call Insert_Row(xlApp, ws(3), Maxrow, 36)
Call Insert_Row(xlApp, ws(4), Maxrow, 36)
Call Insert_Row(xlApp, ws(5), Maxrow, 37)
Call Insert_Row(xlApp, ws(6), Maxrow, 37)
End Select
End If
Set wk_ws = Nothing: RS.Close: Set RS = Nothing
Set wk_ws = xlBook.Sheets("DB?C")
Set RS = mdb.OpenRecordset("SELECT Temp_DB?C.* FROM Temp_DB?C")
wk_ws.Range("A2").CopyFromRecordset RS '集計したデータを「DB?C」シートへ貼り付け
Maxrow = wk_ws.Cells(wk_ws.Rows.Count, 6).End(xlUp).Row - 1 'レコード件数を取得
Select Case Maxrow 'レコード件数分の行調整
Case 1
ws(2).Range("32:33").Delete
ws(3).Range("33:34").Delete
ws(4).Range("33:34").Delete
ws(5).Range("34:35").Delete
ws(6).Range("34:35").Delete
Case 2
ws(2).Range("33:33").Delete
ws(3).Range("34:34").Delete
ws(4).Range("34:34").Delete
ws(5).Range("35:35").Delete
ws(6).Range("35:35").Delete
Case Is >= 4
Call Insert_Row(xlApp, ws(2), Maxrow, 31)
Call Insert_Row(xlApp, ws(3), Maxrow, 32)
Call Insert_Row(xlApp, ws(4), Maxrow, 32)
Call Insert_Row(xlApp, ws(5), Maxrow, 33)
Call Insert_Row(xlApp, ws(6), Maxrow, 33)
End Select
Set wk_ws = Nothing: RS.Close: Set RS = Nothing
xlApp.Calculate 'Excel再計算
'----- 値貼り付け/作業フィールドの削除 -------------------------
Dim i As Long
For i = 1 To 9
With xlBook.Sheets(i)
.Activate
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Columns("A:L").Delete
End With
Next i
'----- 作業用シートの削除 ------------------------------
For i = 20 To 10 Step -1
xlBook.Sheets(i).Delete
Next i
xlBook.SaveAs "C:\test\"test.xlsx"
xlBook.Close
xlApp.Quit: Set xlApp = Nothing
End Function
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
とりあえず、ご提示のコードには問題ないように見えます。 まぁ、止めなければ正常動作しているのでしょうし。 あとは、途中で止めることで、接続タイムアウトになっていたりはしないでしょうか？ 短時間の停止なら継続できて、長時間の停止だとエラーになる、とか。
（???） 2019/04/04(木) 11:13
詳しくないので、検索だけしてみました。
先ほど検索したときに「メモ型フィールドで951文字以上あるとCopyFromRecordsetでエラーになる」とあったので エラーが出た時はRecordsetの中身をDo〜Loopで書き出すとかにしてみてはどうでしょう？
あとは手動で実行したときに問題になりそうなのは、アクセスではなくエクセルをアクティブにした状態で 続きを実行したときの動作が変わってしまうとか・・・？
今見た限り1回目と2回目の違いでRecordsetがEOFの場合の処置の有無ですが、Recordsetが空っぽでも エラーにはならなかったと思うのでどうなんでしょうね。 （稲葉） 2019/04/04(木) 11:21
（???）さまご返信ありがとうございます。
よくよくみたら、Excelの掲示板でしたね。大変失礼いたしました。
どのコードも正しく動くものをコピーして引数を変更して作成したので見比べてみても同じでした。
5回目をコメントたり、6回目をコメント、2回目をコメントなど色々な個所をコメントアウトして実行しても同様のエラーが発生しました。
またステップインで最後まで実行させると時間がかかっても正常終了するのでタイムエラーでもなさそうです。
（稲葉）さまご返信ありがとうございます。
CopyFromRecordsetがエラーになる場合ということで色々調べましたが、10ケタ程度のコードばかりなので文字数の制限にかかるようなデータではなくOLEオブジェクト型のデータでもなく。。。。。
EOFの件ですが、2回目の処理は必ずデータがあるので、EOFの処理をしていません。
クエリの結果が0件だと、上記のコードで思った通りの動きをしてくれます。
（やたろう） 2019/04/04(木) 17:02
説明がへたくそですみません。
Excelへ貼り付けたいAccessのデータは8つのテーブルになっており、
Excel側にもそれを貼り付けるためのシートを8つ用意しております。
貼り付けたデータのレコード数により、提出用の別のExcelシートの行数を増減させるという処理を行うために
1つ目のデータを貼り付け→Excelの行数調整→2つ目のデータを貼り付け→Excelの行数調整････というように繰り返していたのを、
最初に必要な8つのデータをExcelへ貼り付けしてExcelの各シートの行数調整を行うというように変更しエラーが出なくなりました。
なので貼り付けを1回にすることはできません。
また、CPUを握っているという点についてはおっしゃる通りだと思います。
エラーで中断してしまうとAccessが閉じるて画面上から消えるのにタスクマネージャには残ります。
エラーが起きた際は、ExcelもAccessも開放してアプリを閉じる処理を入れてるのに、腑に落ちない点でした。
（やたろう） 2019/04/05(金) 08:09
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.