投稿日 | : 2004/09/07(Tue) 14:52 |
投稿者 | : 阿呆宮 |
Eメール | : kouichi_anazawa@nbs.nyk.jp |
URL | : |
タイトル | : オラクル参照とレコードセット |
市販の参考書のサンプルプログラムを手入力し、実行させたが、うまくいきません。
オラクルDBより伝票マスタ、サブマスタ、商品一覧TBなどを結合させ、明細伝票の追加、削除
を、行うためのものですが、「商品ID」を入力しても「商品名」が表示されません。
再度、実行すると、手入力した商品IDも、商品名も表示されます。どうも、私のレコードセット
の理解が不十分なため、対応ができない状態になっているようです。
どなたか、対処方法を、教えていただけませんでしょうか?
ーーーーーーーーーーーーーーーーーーーーーーーーー
Option Explicit
Private cn As New ADODB.Connection
Private Sub cmdCancel_Click()
deMain.rscmdMaster.CancelUpdate
If deMain.rscmdMaster.RecordCount <> 0 Then
Call Refreshdata
Call CALCTOTAL
dbgsub.Visible = True
cmdFirst.Enabled = True
cmdPrevious.Enabled = True
cmdNext.Enabled = True
cmdLast.Enabled = True
cmdDelete.Enabled = True
Else
'レコード移動ボタン
cmdFirst.Enabled = False
cmdPrevious.Enabled = False
cmdNext.Enabled = False
cmdLast.Enabled = False
cmdDelete.Enabled = False
End If
cmdAdd.Enabled = True
cmdCancel.Enabled = False
cmdUpdate.Enabled = False
End Sub
Private Sub cmdDelete_Click()
Dim rs As New ADODB.Recordset
Dim ret As Integer
ret = MsgBox("表示中の伝票を削除します、いいですか", _
vbYesNo + vbQuestion + vbDefaultButton2, _
"伝票削除")
Select Case ret
Case vbYes 'はい
'マスター削除
deMain.rscmdMaster.Delete
'詳細削除
Set rs = dbgsub.DataSource
If rs.RecordCount <> 0 Then
rs.MoveFirst
Do Until rs.EOF
rs.Delete
rs.MoveNext
Loop
End If
'カレントレコード設定
'レコードがあるとき
If deMain.rscmdMaster.RecordCount <> 0 Then
deMain.rscmdMaster.MovePrevious
If deMain.rscmdMaster.BOF Then
deMain.rscmdMaster.MoveFirst
End If
Call Refreshdata
Call CALCTOTAL
'レコードがないとき
Else
cmdFirst.Enabled = False
cmdPrevious.Enabled = False
cmdNext.Enabled = False
cmdLast.Enabled = False
cmdDelete.Enabled = False
cmdAdd.SetFocus
deMain.rscmdMaster.AddNew
deMain.rscmdMaster.CancelUpdate
dbgsub.Visible = False
End If
Case vbNo
End Select
End Sub
Private Sub cmdSubDelete_Click()
Dim rs As New ADODB.Recordset
Dim ret As Integer
ret = MsgBox("選択中のレコードを削除しますか", _
vbYesNo + vbQuestion + vbDefaultButton2, _
"削除情報")
Select Case ret
Case vbYes
Set rs = dbgsub.DataSource
rs.Delete
Call Refreshdata
Call CALCTOTAL
cmdSubDelete.Enabled = False
Case vbNo
End Select
End Sub
Private Sub cmdUpdate_Click()
deMain.rscmdMaster.Update
dbgsub.Visible = True
'追加操作関連ボタン
cmdAdd.Enabled = True
cmdUpdate.Enabled = False
cmdCancel.Enabled = False
cmdDelete.Enabled = True
'レコード移動ボタン
cmdFirst.Enabled = True
cmdPrevious.Enabled = True
cmdLast.Enabled = True
End Sub
Private Sub dbgsub_Change()
dbgsub.Columns("伝票番号").Value = txt伝票番号.Text
End Sub
Private Sub form_load()
Dim dbname As String
'dbname = GetDataSource()
cn.ConnectionString = "provider=MSDAORA;USER ID=NASDB;" _
& "PASSWORD=KING; data source=QJ1SV05"
cn.Open
If deMain.rscmdMaster.RecordCount <> 0 Then
Call Refreshdata
Call CALCTOTAL
cmdFirst.Enabled = True
cmdPrevious.Enabled = True
cmdNext.Enabled = True
cmdLast.Enabled = True
cmdDelete.Enabled = True
Else
dbgsub.Visible = False
cmdFirst.Enabled = False
cmdPrevious.Enabled = False
cmdNext.Enabled = False
cmdLast.Enabled = False
cmdDelete.Enabled = False
End If
cmdAdd.Enabled = True
cmdUpdate.Enabled = False
cmdCancel.Enabled = False
cmdSubDelete.Enabled = False
End Sub
Private Sub Refreshdata()
Dim rs As New ADODB.Recordset 'record set onject
Dim mySQL As String
' ---------------------------------------------
Set rs = New ADODB.Recordset ' ******test
rs.CursorLocation = adUseClient ' ******test
' --------------------------------------------
mySQL = "SELECT 伝票番号,伝票サブ.商品ID,商品名,単価,数量, " _
& "単価 * 数量 AS 金額 " _
& "FROM 伝票サブ,商品一覧 " _
& "WHERE 伝票サブ.商品ID = 商品一覧.商品ID " _
& "AND 伝票番号 = " & txt伝票番号.Text
'レコードセットを取得
rs.Open mySQL, cn, adOpenStatic, adLockOptimistic
Set dbgsub.DataSource = rs
dbgsub.Columns("伝票番号").Visible = False
dbgsub.Columns("商品ID").Width = 60 * 15
dbgsub.Columns("商品名").Width = 150 * 15
dbgsub.Columns("単価").Width = 60 * 15
dbgsub.Columns("数量").Width = 60 * 15
dbgsub.Columns("金額").Width = 60 * 15
End Sub
Private Sub cmdFirst_Click()
deMain.rscmdMaster.MoveFirst
Call Refreshdata
Call CALCTOTAL
End Sub
Private Sub cmdLast_Click()
deMain.rscmdMaster.MoveLast
Call Refreshdata
Call CALCTOTAL
End Sub
Private Sub cmdNext_Click()
deMain.rscmdMaster.MoveNext
If deMain.rscmdMaster.EOF Then
deMain.rscmdMaster.MoveLast
End If
Call Refreshdata
Call CALCTOTAL
End Sub
Private Sub cmdPrevious_Click()
deMain.rscmdMaster.MovePrevious
If deMain.rscmdMaster.BOF Then
deMain.rscmdMaster.MoveFirst
End If
Call Refreshdata
Call CALCTOTAL
End Sub
Private Sub mnuEditFind_Click()
Dim denNo As String
Dim bmark As Variant
Dim ret As Integer
'ブックマークを保持
bmark = deMain.rscmdMaster.Bookmark
denNo = InputBox("伝票番号を入力してください", "伝票検索")
If denNo = "" Then
Exit Sub
End If
'検索
deMain.rscmdMaster.MoveFirst
deMain.rscmdMaster.Find "伝票番号 =" & CLng(denNo)
'見つからなかったとき
If deMain.rscmdMaster.EOF Then
ret = MsgBox("該当する伝票が見つかりません。", vbOKOnly, "伝票検索")
deMain.rscmdMaster.Bookmark = bmark
'見つかったとき
Else
Call Refreshdata
Call CALCTOTAL
End If
End Sub
Private Sub mnuFilePrint_Click()
deMain.Commands("rptMaster").Parameters("prmNo") = txt伝票番号.Text
'プレビュー画面の大きさ
drDenpyo.Width = 900 * 15
drDenpyo.Height = 600 * 15
'プレビュー表示
drDenpyo.Show
End Sub
Private Sub mnuFileQuit_Click()
Unload Me
End Sub
Private Sub form_unload(cancel As Integer)
Set cn = Nothing
End Sub
Private Sub dbgsub_OnAddNew()
dbgsub.Columns("伝票番号").Value = txt伝票番号.Text
End Sub
Private Sub dbgsub_click()
If dbgsub.SelBookmarks.Count = 0 Then
cmdSubDelete.Enabled = False
Else
cmdSubDelete.Enabled = True
End If
End Sub
Private Sub CALCTOTAL()
Dim rs As New ADODB.Recordset
Dim TOTAL As Long
Dim bmark As Variant
TOTAL = 0
Set rs = dbgsub.DataSource
'新しいデータ
If IsNull(rs!数量) Then
Exit Sub
End If
If rs.RecordCount <> 0 Then
bmark = dbgsub.Bookmark
rs.MoveFirst
End If
'合計金額
Do Until rs.EOF
TOTAL = TOTAL + rs!金額
rs.MoveNext
Loop
TXT合計.Text = CStr(Format(TOTAL, "#,##0"))
'もとのレコードへ
If bmark <> Null Then
dbgsub.Bookmark = bmark
Else
If rs.RecordCount <> 0 Then
rs.MoveLast
End If
End If
End Sub
Private Sub dbgsub_AfterColEdit(ByVal ColIndex As Integer)
dbgsub.Columns("伝票番号").Value = txt伝票番号.Text
' ------------------------TEMPOLARY START 1-----------------------------
' ------------------------TEMPOLARY END 1 ------------------------
Select Case ColIndex
Case 1
Call CALCTOTAL
Case 4
Call CALCTOTAL
Case Else
End Select
' ---------------------------- TEMPOLARY INPUT START2 -----------
End Sub
Private Sub cmdAdd_Click()
Dim rs As New ADODB.Recordset
Dim denNo As Long
'レコードが存在しないとき
If deMain.rscmdMaster.RecordCount = 0 Then
denNo = 0
'レコードが存在するとき
Else
Set rs = deMain.rscmdMaster
rs.Sort = "伝票番号 ASC"
rs.MoveLast
denNo = rs!伝票番号
Set rs = Nothing
End If
'伝票を追加
deMain.rscmdMaster.AddNew
txt伝票番号.Text = denNo + 1
txt日付.Text = Date
txt日付.SetFocus
Call Refreshdata
Call CALCTOTAL
dbgsub.Visible = False
'コントロールの設定
cmdAdd.Enabled = False
cmdUpdate.Enabled = True
cmdCancel.Enabled = True
cmdDelete.Enabled = False
cmdFirst.Enabled = False
cmdPrevious.Enabled = False
cmdNext.Enabled = False
cmdLast.Enabled = False
End Sub
Private Sub mnuOptionExport_Click()
On Error GoTo ERR_MNUOPTIONEXPORT_CLICK
Dim ret As Integer
'保存ダイアログボックス
dlgSave.InitDir = App.Path
dlgSave.ShowSave
'csv形式で出力
With deMain.rscmdExport
deMain.rscmdExport.Open
Open dlgSave.FileName For Output As #1
'タイトル
Write #1, "顧客ID", "顧客名", "郵便番号", "都道府県", "住所", "郵便番号"
'データ
.MoveFirst
Do Until .EOF
Write #1, !顧客ID, !顧客名, !郵便番号, !都道府県, !住所, !電話番号
.MoveNext
Loop
Close #1
.Close
End With
'終了
ret = MsgBox("エクスポート終了しました", vbOKOnly, "エクスポート")
ERR_MNUOPTIONEXPORT_CLICK:
End Sub