经测试新建的ACCESS数据库无论后缀名是否改.mdb或.accdb都可以使用自协调,而使用New ADOX.Catalog()创建的数据库无法使用自协调。整个示例工程打包下载
'Imports System.IO
'Imports ADOX
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Static 数据源 = "Provider = Microsoft.ACE.OLEDB.12.0; Data Source = VB解答专用数据库.mdb" 'VB解答专用数据库.accdb
Dim 查询字符串 = "%%", 对应表名 = "人员表",
查询语句 = "SELECT * FROM " + 对应表名 + " WHERE 姓名 like'" + 查询字符串 + "' order by 姓名 ASC"
自动协调更新数据行(数据源, 查询语句, 对应表名) '经测试新建的ACCESS数据库无论后缀名是否改.mdb或.accdb都可以使用自协调,而使用New ADOX.Catalog()创建的数据库无法使用自协调。
Dim 数据表1 = 读文本到数据表(System.Environment.CurrentDirectory + "\\数据1.txt")
Dim 数据表2 = 读文本到数据表(System.Environment.CurrentDirectory + "\\数据2.txt")
数据表1.TableName = "测试表"
判断数据库文件(数据表1, "测试用例.mdb")
'Dim 缓存数据表 As DataSet = New DataSet
'缓存数据表.Merge(数据表1)
'Dim 数据源 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= 测试用例.mdb"
'Dim 筛选 = 数据表2.DefaultView
'筛选.Sort = "Equipment ASC, SMT_TIME DESC"
'数据表2 = 筛选.ToTable
'筛选 = 数据表1.DefaultView
'筛选.Sort = "Equipment ASC"
'数据表1 = 筛选.ToTable
'自适应更新()
End Sub
Sub 更新数据(ByVal 数据表 As DataTable, ByVal 数据源 As String, ByVal 表名称 As String)
Dim 执行 As New List(Of String)
For Each 行 As DataRow In 数据表.Rows
Dim 语句 As String = "UPDATE " + 表名称 + " SET "
Dim xu = 0
For Each 列 As DataColumn In 数据表.Columns
语句 += 列.ColumnName + " = '" + 行(xu) + "' ,"
xu += 1
Next
语句 = 语句.TrimEnd(",") + "WHERE ID = '" + 行(0) + "'"
执行.Add(语句)
Next
AccEss数据库增删改(数据源, 执行) '执行这个语句更新成功,也可以查看文件夹中数据库修改时间看到
End Sub
Sub 插入数据(ByVal 数据表 As DataTable, ByVal 数据源 As String)
Dim 执行 As New List(Of String)
For Each 添加 As DataRow In 数据表.Rows
Dim 语句 As String = "INSERT INTO 测试表 ("
For Each 列 As DataColumn In 数据表.Columns
语句 += 列.ColumnName + ","
Next
语句 = 语句.TrimEnd(",") + ") VALUES ('"
For Each 数据 As String In 添加.ItemArray
语句 += 数据 + "','"
Next
语句 = 语句.TrimEnd("'").TrimEnd(",") + ")"
执行.Add(语句)
Next
AccEss数据库增删改(数据源, 执行)
End Sub
Sub 判断数据库文件(ByVal 数据表 As DataTable, ByVal 文件名称 As String)
Dim 文件 = New IO.FileInfo(System.Environment.CurrentDirectory + "\\" + 文件名称)
Dim 数据源 = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " + 文件名称
If 文件.Exists = False Then
Dim 列名集 = New List(Of String)
For Each 列 As DataColumn In 数据表.Columns
列名集.Add(列.ColumnName)
Next
创建新ACCESS数据库和表(列名集, "测试用例", "测试表")
插入数据(数据表, 数据源)
End If
End Sub
Sub 创建新ACCESS数据库和表(ByVal 列名集 As List(Of String), ByVal 库名称 As String, ByVal 表名称 As String)
'首先需添加引用
'Microsoft ActiveX Data Objects 2.x Library
'Microsoft ADO Ext. 2.x for DDL and Security
'https://blog.csdn.net/muolu_soft/article/details/5610121
Dim 数据源 As ADOX.Catalog = New ADOX.Catalog()
数据源.Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " + 库名称 + ".mdb")
Dim 连接 As ADODB.Connection = New ADODB.Connection
Dim 新表 As ADOX.Table = New ADOX.Table
连接.Open("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + 库名称 + ".mdb")
新表.Name = 表名称
新表.Columns.Append("ID", , ADOX.DataTypeEnum.adInteger)
新表.Keys.Append("ID", ADOX.KeyTypeEnum.adKeyPrimary, "ID")
列名集.Remove("ID")
For Each 列名 As String In 列名集
新表.Columns.Append(列名, ADOX.DataTypeEnum.adVarWChar)
Next
数据源.Tables.Append(新表)
新表 = Nothing
数据源 = Nothing
连接.Close()
连接 = Nothing
End Sub
Sub AccEss数据库增删改(ByVal 数据源 As String, ByVal 语句 As List(Of String))
Dim 数 = 0
Dim 连接 As New OleDb.OleDbConnection(数据源)
连接.Open()
For Each 执行 As String In 语句
Dim 操作 = New OleDb.OleDbCommand(执行, 连接)
数 += 操作.ExecuteNonQuery()
Next
连接.Close()
MessageBox.Show("数据保存成功!受影响数" + 数.ToString("〖00000〗"), "友情提醒", MessageBoxButtons.OK, MessageBoxIcon.Asterisk)
End Sub
Private Sub 自适应更新()
Static cnStr As String = "Provider = Microsoft.ACE.OLEDB.12.0;Data Source = 测试用例.mdb;"
Dim strSql As String = "SELECT * FROM 测试表 order by Equipment ASC, SMT_TIME asc, DT DESC"
Dim ds As DataSet = New DataSet
Using cn As New OleDb.OleDbConnection(cnStr)
Dim da As New OleDb.OleDbDataAdapter(strSql, cn)
Dim Mybuilder As OleDb.OleDbCommandBuilder = New OleDb.OleDbCommandBuilder(da)
da.Fill(ds, "测试表")
ds.Tables(0).Rows(0)(2) = "11112222"
ds.Tables(0).AcceptChanges()
'更新数据(ds.Tables(0), cnStr, "测试表")
'自适应更新数据表必须有主键
Dim dd = Mybuilder.GetUpdateCommand.CommandText
da.Update(ds.Tables(0)) '之上数据库和数据表有打开并读取,就是没执行更新
End Using
End Sub
Sub 自动协调更新数据库(参数 As List(Of Object))
'IIF(条件,执行,执行)
End Sub
Function 自动协调更新数据行(ByVal 数据源 As String, _
ByVal 查询语句 As String, ByVal 对应表名 As String) As DataSet
Dim 缓存数据表 As DataSet = New DataSet
Try
Using 打开连接 As New OleDb.OleDbConnection(数据源)
Dim 数据表更新数据库 As New OleDb.OleDbDataAdapter()
数据表更新数据库.SelectCommand = New OleDb.OleDbCommand(查询语句, 打开连接)
Dim 自动生成协调 As OleDb.OleDbCommandBuilder = New OleDb.OleDbCommandBuilder(数据表更新数据库)
数据表更新数据库.Fill(缓存数据表, 对应表名)
缓存数据表.Tables(0).Rows(2)(1) = "55555"
缓存数据表.Tables(0).Rows(2)(2) = "55555"
'Dim 数据行 As DataRow = 缓存数据表.Tables(0).NewRow
'数据行("姓名") = "无名氏"
'数据行("性别") = "男"
'数据行("生日") = Date.Now()
'缓存数据表.Tables(0).Rows.Add(数据行)
'缓存数据表.Tables(0).TableName = 对应表名
'在此处修改数据集中数据的代码,适用于新的AccEss数据库.accdb且不需要主键改为.mdb也可以。
Dim dd = 自动生成协调.GetUpdateCommand().CommandText
'如果没有OleDbCommandBuilder,此行将失败。
数据表更新数据库.Update(缓存数据表, 对应表名)
'数据表更新数据库.Update(New DataRow() {数据行})
'缓存数据表.AcceptChanges()
End Using
Catch ex As Exception
MessageBox.Show("错误 : 请联系管理员=>" + ex.ToString, "有情提示", MessageBoxButtons.OK)
End Try
Return 缓存数据表
End Function
Function 读文本到数据表(ByVal 文件路径 As String) As DataTable
Dim aa = New DataTable
Dim 文行 As String
Dim 文件 = New IO.FileInfo(文件路径)
If 文件.Exists Then
Using 打开 = New IO.FileStream(文件路径, IO.FileMode.Open)
Using 读取 = New IO.StreamReader(打开, System.Text.Encoding.GetEncoding("GB2312"))
While 读取.EndOfStream = False
文行 = 读取.ReadLine()
If 文行.IndexOf("ID") = 0 Then
For Each ss In 文行.Split(" ")
aa.Columns.Add(ss)
Next ss
Else
aa.Rows.Add(文行.Split(" "))
End If
End While
End Using
End Using
End If
Return aa
End Function
Function 字符串转数据表() As DataTable
Dim aa = New DataTable
For Each ss In "内码 简拼 品名 成份名 药品类别 规格 配伍禁忌".Split(" ")
aa.Columns.Add(ss)
Next ss
For Each ss In "47019 RS 人参 人参 人参 支 藜芦;1111 LL 藜芦 藜芦 藜芦 g 人参,党参,玄参,西洋参,细辛;33212 XX 细辛 细辛 细辛 g 藜芦;2222 RS 蚺蛇 蚺蛇 蚺蛇 g 全蝎".Split(";")
aa.Rows.Add(ss.Split(" "))
Next ss
Return aa
End Function
Sub 查询数据()
Dim ts = ""
Dim dd As DataRow
For Each dd In 字符串转数据表().Rows
If dd.ItemArray.Contains("RS") Then
ts += String.Join(" ", dd.ItemArray) + Chr(13) + Chr(10)
End If
Next dd
MessageBox.Show(ts, "友情提示:")
End Sub
Sub 让字母循环()
Dim aa = " D E F G H", bb = aa, ff = 1, hh = 0, jj = 0
For Each SS In aa
bb += aa
jj = 12 * ff + hh
If bb.Length > jj Then
bb = bb.Insert(jj, (Chr(13) + Chr(10)).ToString())
ff += 1
hh += 2
End If
If ff > 6 Then Exit For
Next
MessageBox.Show(bb.Substring(0, jj), "友情提示:")
End Sub
End Class
'查询数据()
'Dim 列表 As New DataGrid
'列表.Parent = Me
'列表.Size = New Size(600, 200)
'Dim 数据表 = 字符串转数据表()
'Dim 筛选 = "简拼 Like '%" + "RS" + "%' "
'列表.DataSource = 数据表
'Dim 筛选表 = 数据表.DefaultView
'筛选表.RowFilter = 筛选