hhg4 发表于 2005-5-11 16:04:00

[求助]

请教斑竹;
以下是我用VB调用ACCESS数据库的一段程序,前面一段是关于登录窗体的,后面是主窗体.在ACCESS中插入了对象,数据库保存在Template子目录下.与ACCESS的连结通过数据窗体向导实现,许多代码是自动生成.程序调试时提示:数据库路径为不合法路径.且在登陆窗体上输入用户名和密码后提示:密码错误!请斑竹帮忙看一下程序有哪些错误以及还有哪些需要改进的地方.
下面是登录窗体程序:
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
        On Error Resume Next
                       Dim sqlstr As String
                       sqlstr = "select * from 用户表 where 用户名 = '" & Trim(txtUserName.Text) & "'and 密码 = '" & Trim(txtPassword.Text) & "'"
                       Me.Data1.RecordSource = sqlstr
                       Me.Data1.Refresh
                       If Me.Data1.Recordset.RecordCount = 0 Then
                                                       MsgBox "密码错误!"
                       Else
                                                       frmMain.Show
                                                       Unload Me
                       End If
End Sub
Private Sub Form_Load()
                       Me.Data1.DatabaseName = App.Path & "\ Template \ 产品图档管理系统97.mdb"
End Sub
以下是主窗体程序:
Private Sub Command1_Click()
                       Dim str As String
                       If Combol.Text = " " Or Text1.Text = " " Then
                                                       MsgBox "请输入查询条件和内容!"
                                                       Exit Sub
                       End If
                       str = Combol.Text & "like" & "'" & Text1.Text & "'"
                       datPrimaryRS.Recordset.Find str
                       If datPrimaryRS.Recordset.AbsolutePosition < adPosBOF Then
                                                       MsgBox "没有相应的记录!"
                                                       datPrimaryRS.Recordset.MoveFirst
                                                       
                       End If
End Sub
Private Sub Form_Load()
Me.datPrimaryRS.ConnectionString = "PROVIDER = Microsoft.Jet.OLEDB.3.51;datasource=" & App.Path & " \template\产品图档管理系统97.mdb;"
Me.datPrimaryRS.RecordSource = "select 备注说明,编号,产品材料,产品名称,产品数量,产品图号,产品图形,绘图比例,绘图人,绘图日期,设计单位,设计人,设计日期,设计文档,审阅人,审阅日期,图形文件名 from 产品图档 Order by 产品图号"
Me.datPrimaryRS.Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
       Screen.MousePointer = vbDefault
End Sub
Private Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
       'This is where you would put error handling code
       'If you want to ignore errors, comment out the next line
       'If you want to trap them, add code here to handle them
       MsgBox "Data error event hit err:" & Description
End Sub
Private Sub datPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
       'This will display the current record position for this recordset
       datPrimaryRS.Caption = "Record: " & CStr(datPrimaryRS.Recordset.AbsolutePosition)
End Sub
Private Sub datPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
       'This is where you put validation code
       'This event gets called when the following actions occur
       Dim bCancel As Boolean
       Select Case adReason
       Case adRsnAddNew
       Case adRsnClose
       Case adRsnDelete
       Case adRsnFirstChange
       Case adRsnMove
       Case adRsnRequery
       Case adRsnResynch
       Case adRsnUndoAddNew
       Case adRsnUndoDelete
       Case adRsnUndoUpdate
       Case adRsnUpdate
       End Select
       If bCancel Then adStatus = adStatusCancel
End Sub
Private Sub cmdAdd_Click()
       On Error GoTo AddErr
       datPrimaryRS.Recordset.AddNew
       Exit Sub
AddErr:
       MsgBox Err.Description
End Sub
Private Sub cmdDelete_Click()
       On Error GoTo DeleteErr
       With datPrimaryRS.Recordset
                       .Delete
                       .MoveNext
                       If .EOF Then .MoveLast
       End With
       Exit Sub
DeleteErr:
       MsgBox Err.Description
End Sub
Private Sub cmdUpdate_Click()
       On Error GoTo UpdateErr
       datPrimaryRS.Recordset.UpdateBatch adAffectAll
       Exit Sub
UpdateErr:
       MsgBox Err.Description
End Sub
Private Sub cmdClose_Click()
       Unload Me
End Sub
页: [1]
查看完整版本: [求助]