autocad vba与数据库的连接
<p>本人最近想编一个小程序,用来统计DWG中的零件数据,程序如下,已能运行,但不知道为什么不能录入英文,有哪位大侠能帮忙指导一下,运界面如附件:</p><p>Option Explicit<br/>Dim adoCon As Connection '连接对象<br/>Dim adoRs As Recordset '记录集对象<br/>Dim strPath As String</p><p>Private Sub cmdAdd_Click()<br/> Dim control As control<br/> For Each control In Form1.Controls<br/> If TypeOf control Is TextBox Then<br/> If control.Text = "" Then<br/> MsgBox "参数不能为空，请重新输入！", vbCritical<br/> Exit Sub<br/> End If<br/> End If<br/> Next<br/> <br/> On Error GoTo errHandle</p><p> '添加新的记录<br/> With adoRs<br/> .AddNew<br/> <br/> .Fields(0) = txtId.Text<br/> .Fields(1) = txtptStX.Text<br/> .Fields(2) = txtptStY.Text<br/> .Fields(3) = 0<br/> .Fields(4) = txtptEnX.Text<br/> .Fields(5) = txtptEnY.Text<br/> .Fields(6) = 0<br/> <br/> .Update<br/> End With<br/> <br/> Exit Sub<br/>errHandle:<br/> If Err.Number = -2147467259 Then<br/> MsgBox "首先修改文本框中的数值，然后单击“添加”按钮，完成添加的操作。", vbCritical<br/> End If<br/> Err.Clear<br/> <br/> '由于添加数据失败，不能更新数据库，故取消更新<br/> adoRs.CancelUpdate<br/>End Sub</p><p>Private Sub cmdDelete_Click()<br/> On Error Resume Next<br/> <br/> If MsgBox("删除当前记录？", vbYesNo, "确认删除") = vbYes Then<br/> adoRs.Delete adAffectCurrent<br/> <br/> If adoRs.EOF Then<br/> adoRs.MoveLast<br/> Else<br/> adoRs.MoveNext<br/> End If<br/> End If<br/> <br/> ExchangeData False<br/>End Sub</p><p>Private Sub cmdExit_Click()<br/> Unload Me<br/>End Sub</p><p>Private Sub cmdFirst_Click()<br/> adoRs.MoveFirst<br/> <br/> ExchangeData False<br/>End Sub</p><p>Private Sub cmdLast_Click()<br/> adoRs.MoveLast<br/> <br/> ExchangeData False<br/>End Sub</p><p>Private Sub cmdModify_Click()<br/> ExchangeData True<br/>End Sub</p><p>Private Sub cmdNext_Click()<br/> On Error Resume Next<br/> <br/> '如果已经到达末尾<br/> If adoRs.EOF Then<br/> adoRs.MoveLast<br/> Else<br/> adoRs.MoveNext<br/> End If<br/> <br/> ExchangeData False<br/>End Sub</p><p>Private Sub cmdPrevious_Click()<br/> On Error Resume Next<br/> <br/> If adoRs.BOF Then<br/> adoRs.MoveFirst<br/> Else<br/> adoRs.MovePrevious<br/> End If<br/> <br/> ExchangeData False<br/>End Sub</p><p>Private Sub UserForm_Initialize()<br/> '必须首先获得当前的工程路径<br/> strPath = ThisDrawing.Application.VBE.ActiveVBProject.FileName<br/> <br/> '连接数据库<br/> Set adoCon = New Connection<br/> adoCon.CursorLocation = adUseClient<br/> adoCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _<br/> Left(strPath, Len(strPath) - 8) & "lineData.mdb;"<br/> <br/> '打开记录集<br/> Set adoRs = New Recordset<br/> adoRs.Open "ptStEn", adoCon, adOpenDynamic, adLockOptimistic<br/> <br/> If adoRs.RecordCount > 0 Then<br/> adoRs.MoveLast<br/> adoRs.MoveFirst<br/> <br/> ExchangeData False<br/> End If<br/>End Sub</p><p>Private Sub UserForm_Terminate()<br/> '关闭连接和记录集<br/> adoRs.Close<br/> adoCon.Close<br/>End Sub</p><p>'bSave参数取True，表示将文本框中的内容保存到数据库中；取False表示读取数据库的内容<br/>Private Sub ExchangeData(ByVal bSave As Boolean)<br/> If bSave Then<br/> adoRs.Fields(0) = txtId.Text<br/> adoRs.Fields("ptst(x)") = txtptStX.Text '保存内容仍可使用字段名称或者索引号访问数据库内容<br/> adoRs.Fields("ptst(y)") = txtptStY.Text<br/> adoRs.Fields(4) = txtptEnX.Text<br/> adoRs.Fields(5) = txtptEnY.Text<br/> Else<br/> txtId.Text = adoRs.Fields("ObjectID") '根据字段名称或者索引均可以访问其内容<br/> txtptStX.Text = adoRs.Fields(1)<br/> txtptStY.Text = adoRs.Fields(2)<br/> txtptEnX.Text = adoRs.Fields(4)<br/> txtptEnY.Text = adoRs.Fields(5)<br/> End If<br/>End Sub<br/></p>
页:
[1]