Access VBA質問箱 IV

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

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


1522 / 2272 ツリー ←次へ | 前へ→

【6746】SeekとArray 山田 05/11/5(土) 16:39 質問[未読]
【6748】Re:SeekとArray 小僧 05/11/5(土) 18:27 発言[未読]
【6756】Re:SeekとArray 山田 05/11/7(月) 9:54 質問[未読]
【6758】Re:SeekとArray 小僧 05/11/7(月) 11:40 回答[未読]

【6746】SeekとArray
質問  山田  - 05/11/5(土) 16:39 -

引用なし
パスワード
   以下のようなコードを書いてみました。
特にエラーは出ないのですが
rsTBにデータがAddNewされません。
どなたか分かる方教えて下さい。

rsWB.MoveFirst

Do Until rsTB.EOF

rsTB.MoveFirst
rsTB.Seek Array(rsWB![期], rsWB![出張所CD], rsWB![費目CD], rsWB![営現CD]), adSeekFirstEQ

If rsTB.EOF Then
   rsTB.AddNew
   rsTB![期] = rsWB![期]
   rsTB![出張所CD] = rsWB![出張所CD]
   rsTB![費目CD] = rsWB![費目CD]
   rsTB![営現CD] = rsWB![営現CD]
   rsTB.Update
End If
   rsWB.MoveNext
Loop

【6748】Re:SeekとArray
発言  小僧  - 05/11/5(土) 18:27 -

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

コードの 1部だけをご提示されても、何とも言えませんが
(全部提示されれば回答できるとも言えませんが)


>If rsTB.EOF Then

で False の値しか返していないという事ではないのでしょうか。

【6756】Re:SeekとArray
質問  山田  - 05/11/7(月) 9:54 -

引用なし
パスワード
   全てのモジュールです。
宜しくお願いします。

Public Sub WT_予算B_作成()
Dim cN As ADODB.Connection
'費目マスタ
Dim rsH As ADODB.Recordset
'出張所マスタ
Dim rsSB As ADODB.Recordset
'メインテーブル
Dim rsTB As ADODB.Recordset
'ワークテーブル
Dim rsWB As ADODB.Recordset
Dim xSQL1 As String
Dim xSQL2 As String

Set cN = CurrentProject.Connection
Set rsH = New ADODB.Recordset
Set rsSB = New ADODB.Recordset
Set rsTB = New ADODB.Recordset
Set rsWB = New ADODB.Recordset
Set rsGBB = New ADODB.Recordset

rsH.Open "SELECT T_費目マスタ.* FROM T_費目マスタ " & _
     "WHERE (((T_費目マスタ.除)<>1));", cN, adopkeyset, adLockReadOnly

rsSB.Open "SELECT T_出張所マスタ.* FROM T_出張所マスタ " & _
     "WHERE (((T_出張所マスタ.除)<>1));", cN, adopkeyset, adLockReadOnly
     
rsTB.Open "SELECT T_予算B.* FROM T_予算B " & _
     "WHERE (((T_予算B.期)=DLookUp('期','T_管理マスタ','ID=1')));", cN, adopkeyset, adLockOptimistic

rsWB.Open "WT_予算B", cN, adopkeyset, adLockOptimistic

'〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜
'WT_予算Bを初期化
'〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜
xSQL1 = "DELETE WT_予算B.* FROM WT_予算B;"

DoCmd.RunSQL xSQL1

'〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜
'T_予算BのデータをWT_予算Bに昨期予算を出張所編成に合わせて合計したデータを追加
'〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜
xSQL2 = "INSERT INTO WT_予算B ( 期, 出張所CD, 費目CD, 営現CD, 今1, 今2, 今3, 今4 ) " & _
    "SELECT DLookUp('期','T_管理マスタ','ID=1') AS 新期, T_出張所マスタ.集計CD, T_予算B.費目CD, T_予算B.営現CD, Sum(T_予算B.今1) AS 今1の合計, Sum(T_予算B.今2) AS 今2の合計, Sum(T_予算B.今3) AS 今3の合計, Sum(T_予算B.今4) AS 今4の合計 " & _
    "FROM T_出張所マスタ INNER JOIN T_予算B ON T_出張所マスタ.出張所CD = T_予算B.出張所CD " & _
    "WHERE (((T_予算B.期) = DLookup('期', 'T_管理マスタ', 'ID=1') - 1)) " & _
    "GROUP BY T_予算B.期, T_出張所マスタ.集計CD, T_予算B.費目CD, T_予算B.営現CD;"
   
DoCmd.RunSQL xSQL2

'〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜
'WT_予算BのデータをT_予算Bを追加
'〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜

rsWB.MoveFirst

Do Until rsTB.EOF

rsTB.MoveFirst

rsTB.Seek Array(rsWB![期], rsWB![出張所CD], rsWB![費目CD], rsWB![営現CD]), adSeekFirstEQ

If rsTB.EOF Then
   rsTB.AddNew
   rsTB![期] = rsWB![期]
   rsTB![出張所CD] = rsWB![出張所CD]
   rsTB![費目CD] = rsWB![費目CD]
   rsTB![営現CD] = rsWB![営現CD]
   rsTB.Update
End If
   rsWB.MoveNext
Loop

rsH.Close
rsSB.Close
rsTB.Close
rsWB.Close
cN.Close

End Sub

【6758】Re:SeekとArray
回答  小僧  - 05/11/7(月) 11:40 -

引用なし
パスワード
   ▼山田 さん:
こんにちは。

>特にエラーは出ないのですが

という事でしたが、ご提示されたコードで本当にエラーがでないのでしょうか。
当方の環境ですとエラー退治だけで一苦労でしたが…。


掲示板で質問して、何かしらのヒントを得たいという気持ちは解るのですが、
例えばご提示されたコードで

>'費目マスタ
>Dim rsH As ADODB.Recordset
>'出張所マスタ
>Dim rsSB As ADODB.Recordset

>Set rsH = New ADODB.Recordset
>Set rsSB = New ADODB.Recordset

>rsH.Open "SELECT T_費目マスタ.* FROM T_費目マスタ " & _
>     "WHERE (((T_費目マスタ.除)<>1));", cN, adopkeyset, adLockReadOnly

>rsSB.Open "SELECT T_出張所マスタ.* FROM T_出張所マスタ " & _
>     "WHERE (((T_出張所マスタ.除)<>1));", cN, adopkeyset, adLockReadOnly

これらは何の意味があるのでしょうか。
(ご提示して頂いた部分ですと開いて閉じているだけに思えますが。)

色々とうまく行かない事があってゴミが残ってしまっているのかもしれませんが、
質問をする際に手間を惜しまずに、提示するコードを今一度見直してみてください。

現在の所、
1) レコードセットの Open を記述する位置
2) Open する際の引数(記述ミス?)
3) Open する際の引数(adCmdTableDirect の指定漏れ)
4) Seek の際にインデックスを指定していない

等など、エラーが発生してしまう箇所がいくつかあります。


※ コードを見ての感想なのですが、
  不一致クエリ + 追加クエリ でもできそうですね。
  ADO より SQL で行う方が得意なのでしたら
  そちらでも検討されてみるのもいいかと思われます。

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