コメント |
http://lightbox.cocolog-nifty.com/photos/app/ref_studio.png
http://lightbox.cocolog-nifty.com/photos/app/ref_adodb_2.png
↓MDB のダウンロードページ
http://winofsql.jp/VA003334/download051208140702.htm
@DIV
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
@C:red(UpdateMDB)(Rs, Cn2, Rs2)
Rs.MoveNext()
Loop
Rs.Close()
Cn2.Close()
Cn.Close()
MessageBox.Show("更新が終了しました")
End Sub
Private Sub @C:red(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
@END
|