VB.NETからAccessデータベースを更新する

VB.NETからAccessデータベースを更新する

VB.NET で MSAccess のデータベースをどうにかするシリーズ、一応今回で完結です！　INSERT と UPDATE を実装していきますー。


関連記事

  1. DataGridViewへAccessのデータベースファイルを読み込む
  2. AccessDBテーブルの主キー情報を取得する
  3. DataGridViewに読み込んだDB情報を再取得する
  4. DataGridViewをセル編集したときの行数を格納する
  5. Accessのデータベースファイルへ書き込むための接続・切断
  6. Accessデータベースのレコードを削除する
  7. Accessデータベースを更新する ←NOW!

ガッツリ続き物になってしまいました…。過去の分と合わせて順番に読んでいただけると分かりやすいかと思います。

なるべく簡素に書いているので、例外処理は甘いと思われます。ご参考にする際は、ご自分の環境に合わせてご修正ください。

解説のためツギハギしちゃったので、最後の記事（7回め）に全コードまとめてあります。

書いたときの環境

  • Visual Studio 2010
  • .NET Framework 4.0

です。

SQL文を生成する

150316-1

今までの実装で、追加や変更したセルに色がついて該当行（ゼロから始まる）が格納されているはずです。ここで「保存」ボタンを押して走るコードを実装します。

Form2.vb

Button2のクリックイベントに書きます。

'### Form2.vb ###
Public Class Form2
	'略

	'----------------------------------------------------
	'　　　　メソッド
	'----------------------------------------------------
	'略

	'----------------------------------------------------
	'　　Formイベント
	'----------------------------------------------------
	'略

	'----------------------------------------------------
	'　　Buttonクリックイベント
	'----------------------------------------------------
	Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
		'再読込ボタン（Button1）クリック時（略）
	End Sub

	Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
		'保存ボタン（Button2）クリック時

		'編集データが無かったら終了
		If list.hasUpdateList = False And list.hasInsertList = False Then
			Exit Sub
		End If

		'UPDATEのSQL文リストを取得
		Dim sqlList As New List(Of String)
		sqlList = db.getUpdateSql(list.updateList)
		'INSERTのSQLの文リストを取得
		Dim sqlList2 As New List(Of String)
		sqlList2 = db.getInsertSql(list.insertList)
		'UPDATEとINSERTのリストをマージ
		sqlList.AddRange(sqlList2)

		'SQLを実行
		If db.runSQL(sqlList) = True Then '成功したら
			'再読込
			db.Dispose()
			Call setTable()
			'メッセージ
			MessageBox.Show("変更を保存しました。")
		End If
	End Sub

	Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
		'削除ボタン（Button3）クリック時（略）
	End Sub

	'----------------------------------------------------
	'　　DataGridViewイベント
	'----------------------------------------------------
	'略
End Class

getUpdateSqlという関数を使ってUPDATE文のリストを生成（32行目）、getInsertSqlという関数を使ってINSERT文のリストを生成（35行目）、その2つを合わせちゃいます（37行目）。

で、そのリストを持って汎用のrunSQLへ（40行目）。

DBtable.vb

上で書いたgetInsertSqlやgetUpdateSql関数を書きます。

'### DBtable.vb ###
Imports System.Data.OleDb

Class DBtable
	'略

	'----------------------------------------------------
	'　　テーブルに関すること
	'----------------------------------------------------
	'略

	'----------------------------------------------------
	'　　SQL文生成に関すること
	'----------------------------------------------------
	Public Function getDeleteSql(ByVal targetRow As Integer) As List(Of String)
		'DELETE文生成（略）
	End Function

	Public Function getInsertSql(insertList As List(Of Integer)) As List(Of String)
		'INSERT文生成
		Dim list As New List(Of String)
		Dim strSQL As String

		'INSERT
		If Not IsNothing(insertList) Then
			For Each targetRow As Integer In insertList
				'INSERT句
				strSQL = "INSERT INTO " & tableName & "("
				'INTO句
				For targetColumn As Integer = 0 To dgv.Columns.Count - 1
					If isAutoIncrement(targetColumn) = False Then	'オートインクリメントじゃない場合
						strSQL &= " " & dgv.Columns(targetColumn).HeaderCell.Value & ","
					End If
				Next
				strSQL = strSQL.Remove(strSQL.Length - 1)	'最後の一文字（,）を削除
				'VALUES句
				strSQL &= " ) VALUES("
				For targetColumn As Integer = 0 To dgv.Columns.Count - 1
					If isAutoIncrement(targetColumn) = False Then	'オートインクリメントじゃない場合
						Dim fieldTxt As String = getFieldTxt(targetRow, targetColumn)	'囲み文字を含めたフィールド文字列を生成
						strSQL &= " " & fieldTxt & ","
					End If
				Next
				strSQL = strSQL.Remove(strSQL.Length - 1)	'最後の一文字（,）を削除
				strSQL &= " )"

				list.Add(strSQL) 'リストに追加
			Next
		End If

		Return list
	End Function

	Public Function getUpdateSql(updateList As List(Of Integer)) As List(Of String)
		'UPDATE文生成
		Dim list As New List(Of String)
		Dim strSQL As String

		'UPDATE文作成
		If Not IsNothing(updateList) Then
			For Each targetRow As Integer In updateList
				'UPDATE句
				strSQL = "UPDATE " & tableName & " SET"
				'SET句
				For targetColumn As Integer = 0 To dgv.Columns.Count - 1
					If isAutoIncrement(targetColumn) = False And isPrimaryKey(targetColumn) = False Then	'オートインクリメント&主キーじゃない場合
						Dim fieldTxt As String = getFieldTxt(targetRow, targetColumn)	'囲み文字を含めたフィールド文字列を生成
						strSQL &= " " & dgv.Columns(targetColumn).HeaderCell.Value & "=" & fieldTxt & ","
					End If
				Next
				strSQL = strSQL.Remove(strSQL.Length - 1)	'最後の一文字（,）を削除
				'WHERE句
				strSQL &= getWhereTxt(targetRow) 'WHERE句を足す

				list.Add(strSQL) 'リストに追加
			Next
		End If

		Return list
	End Function

	Private Function getWhereTxt(ByVal targetRow As Integer) As String
		'WHERE句生成（略）
	End Function

	Private Function getEncloseTxt(ByVal TypeName As String) As String
		'囲み文字の判定（略）
	End Function

	Private Function getFieldTxt(ByVal targetRow As Integer, ByVal targetColumn As Integer) As String
		'フィールド文字列生成
		Dim encloseTxt As String
		Dim fieldTxt As String
		Dim typeName = tableData.Columns(targetColumn).DataType.Name

		If dgv.Rows(targetRow).Cells(targetColumn).Value IsNot DBNull.Value Then 'Nullじゃない場合
			encloseTxt = getEncloseTxt(typeName)
			fieldTxt = encloseTxt & dgv.Rows(targetRow).Cells(targetColumn).Value & encloseTxt
		Else
			If typeName = "Boolean" Then 'BooleanでNULL判定されたときはfalseにする
				fieldTxt = "false"
			Else
				fieldTxt = "NULL"
			End If
		End If
		Return fieldTxt
	End Function
End Class

19～52行目が、INSERT文をリスト型で返すgetInsertSqlという関数。insertList を参照しながら、追加のあった行のフィールド名を値をそれぞれ並べて、INSERT文を生成します。値は、囲み文字を含めた形を取得するgetFieldTxtという関数を呼んでいます（40行目）。

54～80行目が、UPDATE文をリスト型で返すgetUpdateSqlという関数。updateList を参照しながら、変更のあった行を「フィールド名=値」という形にして、UPDATE文を生成します。ここでも、囲み文字を含めた値を取得するgetFieldTxt関数を呼んでいます（67行目）。WHERE句は、DELETE のときにも使ったgetWhereTxt関数も使ってます（73行目）。

両方から呼ばれてるgetFieldTxt関数は90～107行目。値がなければ Null、あれば囲み文字が違うのでgetEncloseTxt関数（前回作ったやつ）を呼び出したり、まぁいろいろやってます。

使ってみたら、DataGridView の新行かつ型が Boolean で何もセルを触らなかった場合、「false」でなく「NULL」と判定されてしまう現象が確認できたので、100～101行目で処理しています。他にも何かあったらここで設定したほうが良いかもしれません。

動作確認

動かしてみます。

150316-1

中身を変えて「保存」ボタンを押すと、

150316-2

出来た！　…けど、あれ？　INSERT した行が一番上になってる…。

調べてみると、こちらのページの最後の方にこうありました。

並び順を指定しなかった場合取得したレコードは予測不可能な順番で並んでいるということを覚えておいてください。
なお、並び順を指定する場合はSQL文でORDER BYを使用します。

（中略）

SQL Serverの場合は並び順を指定しなかった場合はクラスタードインデックス(つまり主キー)の順に自動的に整列します。つまり、このあたりの仕様はデータベースによって異なります。そういったことをこまごまと気にするのは大変なので順番が重要な場合はORDER BYを指定する癖をつけておきましょう。

なるほど。ちなみにこの VB で新しく追加したレコードを Access を起動して見てみたら、そちらでは一番下に追加されていましたので、DataGridView の仕様かもしれません。気になる方は ORDER BY で並び順もきちんと指定してあげるのが良さそうです。

こんな感じですが、一応、当初やりたかった機能は全て実装することが出来たので、これでこのシリーズは終了になります。需要は少ない気がしますが、どなたかのお役に立てたら光栄です。

全コード

7回に分けてツギハギしてきたので、ここで全部載せておきます。フォームのデザインは最初の記事にあります。

Form1.vb

'### Form1.vb ###
Public Class Form1
	Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
		Form2.Text = Button1.Text 'タイトルをテーブル名に
		Form2.Show() 'Fomr2を表示
	End Sub

	Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
		Form2.Text = Button2.Text 'タイトルをテーブル名に
		Form2.Show() 'Fomr2を表示
	End Sub
End Class

Form2.vb

'### Form2.vb ###
Public Class Form2
	Private Const FILE_NAME As String = "C:\test.accdb"
	Private db As DBtable
	Private list As TargetList
	Private dgv As DataGridView

	'----------------------------------------------------
	'　　　　メソッド
	'----------------------------------------------------
	Private Sub setTable()
		'DataGridViewにテーブル内容をセット
		db = New DBtable(Me.Text, FILE_NAME) 'DBtableインスタンス生成
		db.setDataSource() 'データセット
		list = New TargetList	'TargetListインスタンス生成
		dgv.CurrentCell = Nothing	'DataGridView1の選択解除
	End Sub

	Private Sub undoValue()
		'元の値に戻す
		dgv.CurrentCell.Value = cellValue
	End Sub

	'----------------------------------------------------
	'　　Formイベント
	'----------------------------------------------------
	Private Sub Form2_Load(sender As System.Object, e As System.EventArgs) Handles Me.Load
		'フォームロード時
		dgv = Me.DataGridView1
		Call setTable()
	End Sub

	Private Sub Form2_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
		'フォームが閉じるとき
		'未保存データ確認
		If list.hasUpdateList = False And list.hasInsertList = False Then
			Exit Sub
		End If
		If MessageBox.Show("未保存のデータがあります。フォームを閉じてよろしいですか？", "確認", MessageBoxButtons.OKCancel) <> 1 Then
			e.Cancel = True
		End If
	End Sub

	Private Sub Form2_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
		'フォームが閉じたとき
		db.Dispose()
	End Sub

	'----------------------------------------------------
	'　　Buttonクリックイベント
	'----------------------------------------------------
	Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
		'再読込ボタン（Button1）クリック時
		db.Dispose()	'いったん破棄
		Call setTable()
	End Sub

	Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
		'保存ボタン（Button2）クリック時

		'編集データが無かったら終了
		If list.hasUpdateList = False And list.hasInsertList = False Then
			Exit Sub
		End If

		'UPDATEのSQL文リストを取得
		Dim sqlList As New List(Of String)
		sqlList = db.getUpdateSql(list.updateList)
		'INSERTのSQLの文リストを取得
		Dim sqlList2 As New List(Of String)
		sqlList2 = db.getInsertSql(list.insertList)
		'UPDATEとINSERTのリストをマージ
		sqlList.AddRange(sqlList2)

		'SQLを実行
		If db.runSQL(sqlList) = True Then	'成功したら
			'再読込
			db.Dispose()
			Call setTable()
			'メッセージ
			MessageBox.Show("変更を保存しました。")
		End If
	End Sub

	Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
		'削除ボタン（Button3）クリック時

		'未保存データ確認
		If list.hasUpdateList = True Or list.hasInsertList = True Then
			MessageBox.Show("編集中のデータがあります。先に「保存」か「再読込」を行なってください。")
			Exit Sub
		End If

		'どこも選択されていない場合
		If dgv.CurrentCellAddress.X = -1 Then
			MessageBox.Show("削除したい行を選択してください。", "確認", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
			Exit Sub
		End If

		'削除前確認
		DataGridView1.CurrentRow.Selected = True '対象行をすべて選択
		If MessageBox.Show("選択されている行のデータを削除します。よろしいですか？", "確認", MessageBoxButtons.OKCancel, MessageBoxIcon.Exclamation) <> 1 Then
			Exit Sub
		End If

		'DELETEのSQL文リストを取得
		Dim sqlList As New List(Of String)
		sqlList = db.getDeleteSql(dgv.CurrentRow.Index)

		'SQLを実行()
		If db.runSQL(sqlList) = True Then	'成功したら
			'再読込
			db.Dispose()
			Call setTable()
			'メッセージ
			MessageBox.Show("削除しました。")
		End If
	End Sub

	'----------------------------------------------------
	'　　DataGridViewイベント
	'----------------------------------------------------
	Private errFlg As Boolean
	Private insertFlg As Boolean
	Private cellValue

	Private Sub DataGridView1_DataError(sender As Object, e As System.Windows.Forms.DataGridViewDataErrorEventArgs) Handles DataGridView1.DataError
		'編集でエラーが発生した時
		If Not (e.Exception Is Nothing) Then
			MessageBox.Show(e.ColumnIndex + 1 & "列 " & e.RowIndex + 1 & "行目 のセルでエラーが発生しました。" & vbCrLf & vbCrLf & e.Exception.Message, "エラー", MessageBoxButtons.OK, MessageBoxIcon.Error)
		End If
		e.Cancel = False '値を戻す
		errFlg = True	'エラーフラグを立てる
	End Sub

	Private Sub DataGridView1_UserAddedRow(sender As Object, e As System.Windows.Forms.DataGridViewRowEventArgs) Handles DataGridView1.UserAddedRow
		'新しい行が追加された時
		insertFlg = True
	End Sub

	Private Sub DataGridView1_CellBeginEdit(sender As Object, e As System.Windows.Forms.DataGridViewCellCancelEventArgs) Handles DataGridView1.CellBeginEdit
		'セル編集前
		errFlg = False
		insertFlg = False
		cellValue = dgv.CurrentCell.Value	'該当セルの値を格納しておく
	End Sub

	Private Sub DataGridView1_CellEndEdit(sender As Object, e As System.Windows.Forms.DataGridViewCellEventArgs) Handles DataGridView1.CellEndEdit
		'セル編集後
		If errFlg = False Then
			'オートインクリメントの列は変更不可
			If db.isAutoIncrement(dgv.CurrentCell.ColumnIndex) = True Then
				MessageBox.Show("このセルはオートインクリメントなので変更できません", "エラー", MessageBoxButtons.OK, MessageBoxIcon.Error)
				Call undoValue()
				If insertFlg = False Then Exit Sub '既存レコードだった場合はここで終了
			End If

			'新規レコードだった場合
			If insertFlg = True Then
				If list.inInsertList(dgv.CurrentRow.Index) = False Then	'INSERTリストチェック
					list.addInsertList(dgv.CurrentRow.Index) 'なければINSERTリストに追加
				End If
			Else
				'既存レコードだった場合
				If list.inInsertList(dgv.CurrentRow.Index) = False Then	'INSERTリストになければ
					'主キーなら
					If db.isPrimaryKey(dgv.CurrentCell.ColumnIndex) = True Then
						MessageBox.Show("このセルは主キーなので変更できません", "エラー", MessageBoxButtons.OK, MessageBoxIcon.Error)
						Call undoValue()
						Exit Sub
					End If
					'チェックして追加
					If list.inUpdateList(dgv.CurrentRow.Index) = False Then	 'UPDATEリストチェック
						list.addUpdateList(dgv.CurrentRow.Index)	 'なければUPDATEリストに追加
					End If
				End If
			End If

			'変更したセルに色をつける
			dgv.CurrentCell.Style.BackColor = Color.LavenderBlush
		End If
	End Sub
End Class

DBtable.vb

'### DBtable.vb ###
Imports System.Data.OleDb

Class DBtable
	'フィールド
	Private tableName As Object
	Private fileName As String
	Private dgv As DataGridView = Form2.DataGridView1

	'コンストラクタ
	Sub New(tableName_ As Object, fileName_ As String)
		tableName = tableName_
		fileName = fileName_
	End Sub

	'----------------------------------------------------
	'　　テーブルに関すること
	'----------------------------------------------------
	Private dbCnc As OleDbConnection
	Private dbAdp As OleDbDataAdapter
	Private tableData As DataTable
	Private primaryKeyArray() As DataColumn

	Public Sub setDataSource()
		'テーブルデータ読込
		tableData = getTableData("SELECT * FROM " & tableName & ";")

		'データグリッドビューへバインド
		Dim bindingSource1 As New BindingSource()
		bindingSource1.DataSource = tableData
		dgv.DataSource = bindingSource1

		'フィールド情報
		primaryKeyArray = tableData.PrimaryKey '主キー情報を取得
		Call setColorPrimaryKey()	'主キーのカラムに色つけ
	End Sub

	Private Function getTableData(ByVal strSQL As String) As DataTable
		'テーブルを接続
		dbCnc = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0; " & "Data Source=" & fileName)
		dbAdp = New OleDbDataAdapter(strSQL, dbCnc)
		dbAdp.MissingSchemaAction = MissingSchemaAction.AddWithKey '既定の情報と共に主キーメタデータも読み込む
		Dim table As New DataTable
		dbAdp.Fill(table)
		Return table
	End Function

	Public Sub Dispose()
		'コネクション切断（なくてもいい気もする）
		dbAdp.Dispose()	'アダプター破棄
		dbCnc.Dispose()	'コネクションを破棄
	End Sub

	Private Sub setColorPrimaryKey()
		'データグリッドビューの主キー列色を変える
		For Each clm In primaryKeyArray
			dgv.Columns(clm.Ordinal).HeaderCell.Style.BackColor = Color.LemonChiffon  '主キーのヘッダー色（.EnableHeadersVisualStyles=False にすること）
		Next
	End Sub

	Public Function isPrimaryKey(ByVal targetColumn As Integer) As Boolean
		'主キー列か判定
		Dim checkFlg As Boolean
		For Each clm In primaryKeyArray
			If clm.Ordinal = targetColumn Then checkFlg = True
		Next
		Return checkFlg
	End Function

	Public Function isAutoIncrement(ByVal targetColumn As Integer) As Boolean
		'オートインクリメント列か判定
		Dim checkFlg As Boolean
		If tableData.Columns(targetColumn).AutoIncrement = True Then checkFlg = True
		Return checkFlg
	End Function

	Public Function runSQL(sqlList As List(Of String)) As Boolean
		'テーブル情報の変更
		Dim checkFlg As Boolean

		dbCnc.Open() 'コネクションオープン

		Dim dbCmd As OleDbCommand = dbCnc.CreateCommand
		Dim dbTrz As OleDbTransaction = dbCnc.BeginTransaction
		dbCmd.Connection = dbCnc 'コマンド接続
		dbCmd.Transaction = dbTrz	'トランザクション開始

		Try
			For Each strSQL As String In sqlList
				dbCmd.CommandText = strSQL 'リスト内のSQL文をセット
				dbCmd.ExecuteNonQuery()	'実行
			Next
			dbTrz.Commit() 'コミット（確定）
			checkFlg = True
		Catch ex As Exception
			MessageBox.Show(dbCmd.CommandText & vbCrLf & vbCrLf & ex.Message, "エラー", MessageBoxButtons.OK, MessageBoxIcon.Error) 'エラー内容表示
			dbTrz.Rollback() 'ロールバック
		Finally
			dbCmd.Dispose()	'コマンドを破棄
			dbCnc.Close()	'コネクションを閉じる
		End Try

		Return checkFlg
	End Function

	'----------------------------------------------------
	'　　SQL文生成に関すること
	'----------------------------------------------------
	Public Function getDeleteSql(ByVal targetRow As Integer) As List(Of String)
		'DELETE文生成
		Dim list As New List(Of String)
		Dim strSQL As String

		'DELETE句
		strSQL = "DELETE FROM " & tableName
		'WHERE句
		strSQL &= getWhereTxt(targetRow) 'WHERE句を足す

		list.Add(strSQL) 'リストに追加

		Return list
	End Function

	Public Function getInsertSql(insertList As List(Of Integer)) As List(Of String)
		'INSERT文生成
		Dim list As New List(Of String)
		Dim strSQL As String

		'INSERT
		If Not IsNothing(insertList) Then
			For Each targetRow As Integer In insertList
				'INSERT句
				strSQL = "INSERT INTO " & tableName & "("
				'INTO句
				For targetColumn As Integer = 0 To dgv.Columns.Count - 1
					If isAutoIncrement(targetColumn) = False Then	'オートインクリメントじゃない場合
						strSQL &= " " & dgv.Columns(targetColumn).HeaderCell.Value & ","
					End If
				Next
				strSQL = strSQL.Remove(strSQL.Length - 1)	'最後の一文字（,）を削除
				'VALUES句
				strSQL &= " ) VALUES("
				For targetColumn As Integer = 0 To dgv.Columns.Count - 1
					If isAutoIncrement(targetColumn) = False Then	'オートインクリメントじゃない場合
						Dim fieldTxt As String = getFieldTxt(targetRow, targetColumn)	'囲み文字を含めたフィールド文字列を生成
						strSQL &= " " & fieldTxt & ","
					End If
				Next
				strSQL = strSQL.Remove(strSQL.Length - 1)	'最後の一文字（,）を削除
				strSQL &= " )"

				list.Add(strSQL) 'リストに追加
			Next
		End If

		Return list
	End Function

	Public Function getUpdateSql(updateList As List(Of Integer)) As List(Of String)
		'UPDATE文生成
		Dim list As New List(Of String)
		Dim strSQL As String

		'UPDATE文作成
		If Not IsNothing(updateList) Then
			For Each targetRow As Integer In updateList
				'UPDATE句
				strSQL = "UPDATE " & tableName & " SET"
				'SET句
				For targetColumn As Integer = 0 To dgv.Columns.Count - 1
					If isAutoIncrement(targetColumn) = False And isPrimaryKey(targetColumn) = False Then	'オートインクリメント&主キーじゃない場合
						Dim fieldTxt As String = getFieldTxt(targetRow, targetColumn)	'囲み文字を含めたフィールド文字列を生成
						strSQL &= " " & dgv.Columns(targetColumn).HeaderCell.Value & "=" & fieldTxt & ","
					End If
				Next
				strSQL = strSQL.Remove(strSQL.Length - 1)	'最後の一文字（,）を削除
				'WHERE句
				strSQL &= getWhereTxt(targetRow) 'WHERE句を足す

				list.Add(strSQL) 'リストに追加
			Next
		End If

		Return list
	End Function

	Private Function getWhereTxt(ByVal targetRow As Integer) As String
		'WHERE句生成
		Dim encloseTxt As String
		Dim whereTxt As String = ""

		For Each clm In primaryKeyArray '主キーの列をループ
			If clm.Ordinal = 0 Then
				whereTxt = " WHERE "
			Else '主キーがふたつ以上ある場合
				whereTxt &= " AND "
			End If
			Dim TypeName As String = tableData.Columns(clm.Ordinal).DataType.Name '主キーの型タイプ
			encloseTxt = getEncloseTxt(TypeName) '囲み文字を取得
			whereTxt &= dgv.Columns(clm.Ordinal).HeaderCell.Value & "=" & encloseTxt & dgv.Rows(targetRow).Cells(clm.Ordinal).Value & encloseTxt
		Next

		Return whereTxt
	End Function

	Private Function getEncloseTxt(ByVal TypeName As String) As String
		'囲み文字の判定
		Dim encloseTxt As String
		Select Case TypeName
			Case "String"
				encloseTxt = "'"
			Case "DateTime"
				encloseTxt = "#"
			Case Else
				encloseTxt = ""
		End Select
		Return encloseTxt
	End Function

	Private Function getFieldTxt(ByVal targetRow As Integer, ByVal targetColumn As Integer) As String
		'フィールド文字列生成
		Dim encloseTxt As String
		Dim fieldTxt As String
		Dim typeName = tableData.Columns(targetColumn).DataType.Name

		If dgv.Rows(targetRow).Cells(targetColumn).Value IsNot DBNull.Value Then 'Nullじゃない場合
			encloseTxt = getEncloseTxt(typeName)
			fieldTxt = encloseTxt & dgv.Rows(targetRow).Cells(targetColumn).Value & encloseTxt
		Else
			If typeName = "Boolean" Then 'BooleanでNULL判定されたときはfalseにする
				fieldTxt = "false"
			Else
				fieldTxt = "NULL"
			End If
		End If
		Return fieldTxt
	End Function
End Class

TargetList.vb

'### TargetList.vb ###
Public Class TargetList
	'フィールド
	Private updateList_ As List(Of Integer)
	Private insertList_ As List(Of Integer)

	'ゲッター
	Public ReadOnly Property updateList() As List(Of Integer)
		Get
			Return updateList_
		End Get
	End Property

	Public ReadOnly Property insertList() As List(Of Integer)
		Get
			Return insertList_
		End Get
	End Property

	'----------------------------------------------------
	'　　updateListリストに関すること
	'----------------------------------------------------
	Public Function hasUpdateList() As Boolean
		'UPDATEリストが存在しているかチェック
		Dim checkFlg As Boolean = False
		If Not IsNothing(updateList_) Then
			checkFlg = True
		End If
		Return checkFlg
	End Function

	Public Function inUpdateList(ByVal targetRow As Integer) As Boolean
		'UPDATEリストに既に行があるかチェック
		Dim checkFlg As Boolean = False
		If hasUpdateList() = False Then
			updateList_ = New List(Of Integer)
		Else
			For Each item As Integer In updateList_
				If item = targetRow Then checkFlg = True
			Next
		End If
		Return checkFlg
	End Function

	Public Sub addUpdateList(targetRow As Integer)
		'UPDATEリストへ追加
		updateList_.Add(targetRow)
	End Sub

	'----------------------------------------------------
	'　　insertListリストに関すること
	'----------------------------------------------------
	Public Function hasInsertList() As Boolean
		'UPDATEリストが存在しているかチェック
		Dim checkFlg As Boolean = False
		If Not IsNothing(insertList_) Then
			checkFlg = True
		End If
		Return checkFlg
	End Function

	Public Function inInsertList(ByVal targetRow As Integer) As Boolean
		'INSERTリストに既に行があるかチェック
		Dim checkFlg As Boolean = False
		If hasInsertList() = False Then
			insertList_ = New List(Of Integer)
		Else
			For Each item As Integer In insertList_
				If item = targetRow Then checkFlg = True
			Next
		End If
		Return checkFlg
	End Function

	Public Sub addInsertList(targetRow As Integer)
		'INSERTリストへ追加
		insertList_.Add(targetRow)
	End Sub
End Class

拙いコードですが煮るなり焼くなり。お気づきの点があったら教えて下さい！

公開日：2015/03/16
更新日：2017/04/25

書籍を執筆しています。

はてブ Pocket feedly

2件のコメント

  1. 足立　秀生 より:
    2020年9月26日 8:28 PM

    買った本のとおりにプログラムを組んで実行したらアクセスのデータべースが更新・追加・削除できなくて困っていました。
    ネットで探していたらここにたどり着きました。
    大変勉強になりました。
    私の環境はVB2019Community
    ACCESS2019です。
    無事に動作できました。あとは検索処理取込んでみます。
    ありがとうございました。

    返信
    • *you より:
      2020年9月27日 8:56 AM

      足立さん、だいぶ前に書いたコードがお役に立てたようでたいへん光栄です！　コメント残していただいて嬉しいです、ありがとうございました。


コメントを残す

メールアドレスが公開されることはありません。 ※ が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください。

コメントは承認制ですので、反映までしばらくお待ち下さい。（稀にスパムの誤判定にて届かないこともあるようですので、必要な際はお問い合わせからお願い致します。）

YouTubeでQ&Aコンテンツを企画しています

運営しているYouTubeチャンネルで、ご相談やご質問を募集しています。動画のコメントやお問い合わせページからお気軽にご相談をお寄せください。