ソース掲示板




すべてから検索

キーワード   条件 表示 現行ログ 過去ログ トピックス 名前 本文
【VB.NET】COM経由の ADODB で EXCEL を MDB に更新 ( No.1 )
日時: 2008/05/19 15:23
名前: lightbox







↓MDB のダウンロードページ
http://winofsql.jp/VA003334/download051208140702.htm

Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button1.Click

	' exe が存在するディレクトリ
	Dim ProgPath As String = Application.StartupPath
	Dim ExcelPath As String = ProgPath & "\商品分類マスタ.xls"
	Dim MDBPath As String = ProgPath & "\販売管理B.mdb"

	Dim ConnectionString As String = _
	   "Provider=Microsoft.Jet.OLEDB.4.0;" & _
	   "Data Source=" & ExcelPath & ";" & _
	   "Extended Properties=""Excel 8.0;IMEX=1;"""

	Dim ConnectionString2 As String = _
	  "Provider=Microsoft.Jet.OLEDB.4.0;" & _
	  "Data Source=" & MDBPath & ";"

	' *********************************************
	' 接続
	' *********************************************
	Dim Cn As ADODB.Connection = New Connection()
	Try
		Cn.Open(ConnectionString)
	Catch ex As Exception
		MessageBox.Show(ex.Message)
		Exit Sub
	End Try
	Dim Cn2 As ADODB.Connection = New Connection()
	Try
		Cn2.Open(ConnectionString2)
	Catch ex As Exception
		MessageBox.Show(ex.Message)
		Cn.Close()
		Exit Sub
	End Try

	' *********************************************
	' 入力
	' *********************************************
	Dim Rs As ADODB.Recordset = New Recordset()
	Dim Rs2 As ADODB.Recordset = New Recordset()
	Rs2.LockType = LockTypeEnum.adLockOptimistic


	Dim Query As String = "select * from [商品分類マスタ]"
	Try
		Rs.Open(Query, Cn)
	Catch ex As Exception
		MessageBox.Show(ex.Message)
		Cn.Close()
		Exit Sub
	End Try

	Dim Buffer As String = ""
	Do While Not Rs.EOF

		UpdateMDB(Rs, Cn2, Rs2)
		Rs.MoveNext()

	Loop

	Rs.Close()
	Cn2.Close()
	Cn.Close()

	MessageBox.Show("更新が終了しました")

End Sub

Private Sub UpdateMDB(ByRef Rs As Recordset, ByRef Cn2 As Connection, ByRef Rs2 As Recordset)

	Dim Query As String = "select * from [商品分類マスタ]"
	Query &= " where 商品分類 = '" & Rs.Fields("商品分類").Value & "'"

	Try
		Rs2.Open(Query, Cn2)
	Catch ex As Exception
		MessageBox.Show(ex.Message)
		Exit Sub
	End Try

	If Not Rs.EOF Then
		Rs2.Fields("名称").Value = Rs.Fields("名称").Value
		Rs2.Update()
	End If

	Rs2.Close()

End Sub