本帖最后由 群发软件 于 2017-5-20 00:05 编辑
Imports System
Imports System.IO
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
' 将C:\db1.mdb 做Compact / Repair
If Compact_MDB("C:\db1.mdb") Then MessageBox.Show("OK !")
End Sub
Private Function Compact_MDB(ByVal strFile As String) As Boolean
' Jet Access (MDB) 连线字串; Jet ( Joint Engine Technology )
Dim strCn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0}"
' 或"Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Jet OLEDB:Engine Type=5"
' Path.GetTempFileName 方法: 在磁碟上建立具命之零位元组的唯一暂存档案，
' 然後传回该档案的完整路径。
Dim strTmpFile As String = Path.GetTempFileName.Replace(".tmp", ".mdb") ' 把tmp 副档名改成mdb
' 建立物件阵列存放引数(参数) , 来源, 目的
Dim objPara As Object() = New Object() {String.Format(strCn, strFile), String.Format(strCn, strTmpFile)}
' Activator 成员: 包含本机或远端建立物件型别的方法，或者取得对现有远端物件的参考。
' Activator.CreateInstance 方法(Type) : 使用最符合指定参数的建构函式，建立指定型别的执行个体。
Dim objJRO As Object = Activator.CreateInstance(Type.GetTypeFromProgID("JRO.JetEngine"))
' Type.GetTypeFromProgID 方法: 取得与指定的程式识别项(ProgID) 关联的型别；
' 如果在载入Type 时发生错误，则传回null。
' JRO.JetEngine 为Microsoft Jet and Replication Objects X.X library
' Type.InvokeMember 方法
' Type.InvokeMember (String, BindingFlags, Binder, Object, Object[])
objJRO.GetType.InvokeMember("CompactDatabase", Reflection.BindingFlags.InvokeMethod, _
Nothing, objJRO, objPara)
' 使用指定的系结条件约束并符合指定的引数清单，来叫用指定的成员。
' BindingFlags 列举型别,InvokeMethod 指定要叫用方法。
File.Delete(strFile) ' File.Delete 方法: 删除Compact 前之mdb 档
File.Move(strTmpFile, strFile) ' File.Move 方法: 将Compact 过的mdb 档改成(回)正确档名
' Marshal.ReleaseComObject 方法释放JRO COM 物件
Runtime.InteropServices.Marshal.ReleaseComObject(objJRO)
objJRO = Nothing
Return True
End Function
End Class
引用 Microsoft ActiveX Data Objects 2.8 Library
或者加入microsoft ado data control
定义数据库连接
Dim Cnn As New ADODB.Connection
定义操作记录
Dim Res As New ADODB.Recordset
开始使用
If Res.State = 1 Then Res.Close
Res.CursorLocation = adUseClient
Res.Open "SELECT * From 发票表", Cnn, adOpenDynamic, adLockReadOnly
删除用res.Delete
添加用res.AddNew
res.Fields("序号") = Trim(Res.Fields("序号"))
...
res.Update
更新用Res.Update "序号", 111
列：
'写入产品信息
Sub WriteFP()
'On Error Resume Next
Dim SyBaseRes As New ADODB.Recordset
PB.value = 0
Res.Open "SELECT Count(*) From ICSaleEntry INNER JOIN t_Item ON ICSaleEntry.FItemID = t_Item.FItemID INNER JOIN t_MeasureUnit ON ICSaleEntry.FUnitID = t_MeasureUnit.FMeasureUnitID", SQLServer, adOpenDynamic, adLockReadOnly
Text2.Text = "当前共 " & Val(Res.Fields(0)) & "条数据"
PB.Max = Val(Res.Fields(0))
If Res.State = 1 Then Res.Close
Res.Open "SELECT ICSaleEntry.FDetailID AS 序号,ICSaleEntry.FInterID AS 物料编号, t_Item.FName AS 产品名称,ICSaleEntry.FAuxPrice AS 单价, ICSaleEntry.FAuxQty AS 数量,ICSaleEntry.FAmount AS 原币, ICSaleEntry.FStdAmount AS 本币,t_MeasureUnit.FName AS 单位 FROM ICSaleEntry INNER JOIN t_Item ON ICSaleEntry.FItemID = t_Item.FItemID INNER JOIN t_MeasureUnit ON ICSaleEntry.FUnitID = t_MeasureUnit.FMeasureUnitID", SQLServer, adOpenDynamic, adLockReadOnly
Do While Not Res.EOF
If SyBaseRes.State = 1 Then SyBaseRes.Close
SyBaseRes.Open "select * from 物料表 where 序号='" & Res.Fields("序号") & "'", Cnn, adOpenDynamic, adLockOptimistic
If SyBaseRes.EOF Then
Text2.Text = Text2.Text + vbCrLf + "正在添加: " & Trim(Res.Fields("序号"))
SyBaseRes.AddNew
SyBaseRes.Fields("序号") = Trim(Res.Fields("序号"))
SyBaseRes.Fields("产品编号") = Trim(Res.Fields("物料编号"))
SyBaseRes.Fields("产品名称") = Trim(Res.Fields("产品名称"))
SyBaseRes.Fields("单价") = Trim(Res.Fields("单价"))
SyBaseRes.Fields("数量") = Trim(Res.Fields("数量"))
SyBaseRes.Fields("原币") = Trim(Res.Fields("原币"))
SyBaseRes.Fields("本币") = Trim(Res.Fields("本币"))
SyBaseRes.Fields("单位") = Trim(Res.Fields("单位"))
SyBaseRes.Fields("数据库名") = Trim(Text1.Text)
SyBaseRes.Update
Else
Text2.Text = Text2.Text + vbCrLf + "正在更新: " & Trim(Res.Fields("序号"))
SyBaseRes.Update "序号", Trim(Res.Fields("序号"))
SyBaseRes.Update "产品编号", Trim(Res.Fields("物料编号"))
SyBaseRes.Update "产品名称", Trim(Res.Fields("产品名称"))
SyBaseRes.Update "单价", Trim(Res.Fields("单价"))
SyBaseRes.Update "数量", Trim(Res.Fields("数量"))
SyBaseRes.Update "原币", Trim(Res.Fields("原币"))
SyBaseRes.Update "本币", Trim(Res.Fields("本币"))
SyBaseRes.Update "单位", Trim(Res.Fields("单位"))
SyBaseRes.Update "数据库名", Trim(Text1.Text)
End If
PB.value = PB.value + 1
Res.MoveNext
DoEvents
Loop
If SyBaseRes.State = 1 Then SyBaseRes.Close
Set SyBaseRes = Nothing
End Sub
网络希望不要用ACCESS用ASA（就是sybase那个太强了）
以前使用 DAO 時，Microsoft 有提供 CompactDatabase Method 來压缩 Microsoft Access 文件，RepairDatabase Method 來修复损坏的 Microsoft Access 文件，。可是自从 ADO 出來之后，好像忘了提供相对的压缩及修复 Microsoft Access 文件的功能。
現在 Microsoft 发现了这个问题了，也提供了解決方法，不过有版本上的限制！限制說明如下：
ActiveX Data Objects (ADO), version 2.1
Microsoft OLE DB Provider for Jet, version 4.0
這是 Microsoft 提出的 ADO 的延伸功能：Microsoft Jet OLE DB Provider and Replication Objects (JRO)
这个功能在 JET OLE DB Provider version 4.0 (Msjetoledb40.dll) 及 JRO version 2.1 (Msjro.dll) 中第一次被提出！
這些必要的 DLL 文件在您安裝了 MDAC 2.1 之后就有了，您可以在以下的网页中下载 MDAC 的最新版本！
Universal Data Access Web Site
在下载之前先到 VB6 中檢查一下，【控件】【設定引用項目】中的 Microsoft Jet and Replication Objects X.X library 如果已经是 2.1 以上的版本，您就可以不用下载了！
1、新建一個新表单，选择功能表中的【控件】【設定引用項目】。
2、加入 Microsoft Jet and Replication Objects X.X library，其中 ( X.X 大于或等于 2.1 )。
3、在适当的地方加入以下的程序代码，記得要修改 data source 的內容及目地文件的路径：
Dim jro As jro.JetEngine
Set jro = New jro.JetEngine
jro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\
wind2.mdb", _ '來源文件
在 DAO 3.60 之后，RepairDatabase Method 已经无法使用了，以上的程序代码显示了 ADO CompactDatabase Method 的用法，而它也取代了 DAO 3.5 時的 RepairDatabase method！
|( 京ICP备09078825号 )
发表于 2017-5-20 00:04:31
收藏
