登録処理

  1会話目の確認でエラーチェックを行う



テーブル名は、「学生マスタ」とします。

  
' ****************************************************
' 第1会話から第2会話への画面遷移
' ****************************************************
Private Sub btn確認1会話目_Click()

	If Not CheckHead() Then
		Exit Sub
	End If

	Call HeadProtect
	Call BodyEnable

End Sub

  

  
' ****************************************************
' 第1会話のチェック
' ****************************************************
Private Function CheckHead()

	' 処理区分のチェック
	If InStr("129", txt処理区分.Text) = 0 Then
		MsgBox ("処理区分は、1,2 または 9 を指定して下さい")
		CheckHead = False
		txt処理区分.SetFocus
		txt処理区分.SelStart = 0
		txt処理区分.SelLength = Len(txt処理区分.Text)
		Exit Function
	End If
	
	' コードのチェック
	If Trim(txtコード.Text) = "" Then
		MsgBox ("コードを入力して下さい")
		CheckHead = False
		txtコード.SetFocus
		Exit Function
	End If

	
	' データベースの処理
	Dim objRs As Object
	Dim strSql As String
	Dim bEOF As Boolean
	
	Set objRs = CreateObject("ADODB.Recordset")
	strSql = "select * from 学生マスタ where コード ='" & txtコード.Text & "'"
	
	objRs.Open strSql, g_objCn
	bEOF = objRs.EOF
	objRs.Close
	Set objRs = Nothing

	
	' 登録処理の存在チェック
	If txt処理区分.Text = "1" Then
	
		If Not bEOF Then
			MsgBox ("既に存在しています")
			CheckHead = False
			txtコード.SetFocus
			txtコード.SelStart = 0
			txtコード.SelLength = Len(txtコード.Text)
			Exit Function
		End If
	
	End If

	CheckHead = True

End Function

  

  2会話目の確認でエラーチェック --> 確認 --> 更新 --> 画面リセット



  
' ****************************************************
' 第2会話のコントロール
' ****************************************************
Private Sub btn確認2会話目_Click()

	If Not CheckBody() Then
		Exit Sub
	End If

	If MsgBox("更新しますか?", vbOKCancel) = vbCancel Then
		Exit Sub
	End If

	If UpdateData() Then
		Call BodyClear
		Call BodyProtect
		Call HeadEnable
		txtコード.Text = ""
		txtコード.SetFocus
	End If

End Sub

  

  
' ****************************************************
' 第2会話のチェック
' ****************************************************
Private Function CheckBody()

	' 名前
	With txt名前
		If Trim(.Text) = "" Then
			Call MsgBox("必須入力です", vbOKOnly, "名前")
			.SetFocus
			CheckBody = False
			Exit Function
		End If
	End With

	' 学年
	With txt学年
		If Trim(.Text) = "" Then
			Call MsgBox("必須入力です", vbOKOnly, "学年")
			.SetFocus
			CheckBody = False
			Exit Function
		End If
	End With
	
	CheckBody = True

End Function

  

  
' ****************************************************
' 更新
' ****************************************************
Private Function UpdateData()

	Dim objRs As Object
	Dim strSql As String
	Dim bEOF As Boolean
	
	' レコードセットオブジェクト作成
	Set objRs = CreateObject("ADODB.Recordset")
	
	' レコードセットを更新可能にする
	objRs.LockType = 3
	
	' レコードセット取得用 SELECT
	strSql = "select * from 学生マスタ where コード ='" & txtコード.Text & "'"
	
	' レコードセット取得
	objRs.Open strSql, g_objCn
	
	' 登録処理の存在チェック
	If txt処理区分.Text = "1" Then
	
		' レコード存在の再チェック
		If Not objRs.EOF Then
			MsgBox ("既に存在しています")
			objRs.Close
			Set objRs = Nothing
			UpdateData = False
			Exit Function
		End If
	
		' 新規行の挿入
		objRs.AddNew
		
		' キーのセット
		objRs.Fields("コード").Value = txtコード.Text
		
		' 名前
		objRs.Fields("名前").Value = txt名前.Text
		
		' 学年
		objRs.Fields("学年").Value = txt学年.Text
		
		' 誕生日
		If Trim(txt誕生日) = "" Then
			objRs.Fields("誕生日").Value = Null
		Else
			objRs.Fields("誕生日").Value = _
				Left(txt誕生日.Text, 4) & "/" & _
				Mid(txt誕生日.Text, 6, 2) & "/" & _
				Right(txt誕生日.Text, 2)
		End If
		
		' 電話番号
		If Trim(txt電話番号) = "" Then
			objRs.Fields("電話番号").Value = Null
		Else
			objRs.Fields("電話番号").Value = txt電話番号.Text
		End If
		
		' レコードの更新
		objRs.Update
	
	End If
	
	' レコードセットを閉じる
	objRs.Close
	
	' オブジェクトを開放
	Set objRs = Nothing
	
	' 静止点の確立
	g_objCn.CommitTrans
	
	' トランザクションの開始
	g_objCn.BeginTrans
	
	' 関数の戻り値
	UpdateData = True

End Function

  











   SQLの窓    create:2002/09/03  update:2014/09/07   管理者用(要ログイン)





フリーフォントWEBサービス

SQLの窓WEBサービス

SQLの窓フリーソフト

写真素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ