这样的错误如何解决？

[klj123]

编了个数据库查询代码，运行后提示“自动化错误”，实时错误为“-214702469（8007007f)",代码如下请高手纠错！
Dim adoConn As ADODB.Connection
Dim adoRes As ADODB.Recordset
Dim nameCount As Integer

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Command2_Click()
Dim strSel As String
Dim newItem As ListItem
ListView1.ListItems.Clear
If Trim(Text1.text) = "" Then
MsgBox "请输入查询内容！", 6, "提示!"
Exit Sub

End If

nameCount = 0
strSel = "select * from addrBook where Name like '" + Trim(Text1.text) + "%'"
adoRes.Open strSel, adoConn, , , adCmdText
Do While Not adoRes.EOF
Set newItem = ListView1.ListItems.Add
newItem.text = adoRes!Name
newItem.SubItems(1) = adoRes!jobaddr
newItem.SubItems(2) = adoRes!Phone
newItem.SubItems(5) = adoRes!birth
newItem.SubItems(6) = adoRes!Type
newItem.SubItems(7) = adoRes!code
newItem.SubItems(8) = adoRes!job
newItem.SubItems(4) = adoRes!mobile
newItem.SubItems(3) = adoRes!email
adoRes.MoveNext
nameCount = nameCount + 1
Loop
adoRes.Close

If nameCount = 0 Then
Command1.Enabled = True
Else

End If
End Sub

Private Sub Form_Activate()
Text1.SetFocus
End Sub

Private Sub Form_Load()
Dim strCon As String
nameCount = 0
strCon = App.Path
If Right(strCon, 1) = "\" Then
strCon = strCon + "myAPP.mdb"
Else
strCon = strCon + "\myAPP.mdb"
End If

'打开数据库连接
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + strCon
Set adoConn = New ADODB.Connection
adoConn.Open strCon
Set adoRes = New ADODB.Recordset

End Sub

[Kevin2328]

代码没发现什么问题

[饮水需思源]

在运行的机器上安装mdac2.8mdactyp.exe试试

[klj123]

生成EXE时错误提示出在Set adoConn = New ADODB.Connection中的“New ADODB.Connection”

[cbm6666]

'用你的代码与我的数据库来运行完全没问题了, 如果你那边设置没错的话,你应该也可以运行,因为代码我改得几乎与你一样.

'****** 工程引用Microsoft ActiveX Data Objects 2.5 Library

'部件添加 ListView1 Command1 Command2

'数据库把它与程序放在同一路径

Public adoConn As New ADODB.Connection '定义数据连接字符串
Public adoRes As New ADODB.Recordset '定义记录集
Dim strCon$, Appdisk$, i&, j&
Private Sub Form_Load()
Appdisk = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\")
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & Appdisk & "myAPP.mdb"
adoConn.CursorLocation = adUseClient
adoConn.Open strCon '打开数据库连接
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
End Sub

Private Sub Form_Activate()
Text1.SetFocus
End Sub

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Command2_Click()
Dim xn As ListItem, itm As ListItem, clm As ColumnHeader
Dim strSel As String
If Trim(Text1.Text) = "" Then MsgBox "请输入查询内容！", 6, "提示!": Exit Sub
strSel = "select * from addrBook where Name like '%" & Trim(Text1.Text) & "%'"
adoRes.Open strSel, adoConn, adOpenKeyset, adLockPessimistic '打开记录集
If adoRes.RecordCount > 0 Then adoRes.MoveFirst
'********************************************************************
ListView1.Arrange = lvwAutoLeft
ListView1.LabelWrap = False
ListView1.FlatScrollBar = False
ListView1.ListItems.Clear
ListView1.ColumnHeaders.Clear
ListView1.View = lvwReport
Set clm = ListView1.ColumnHeaders.Add(, , "标题1", 1000)
Set clm = ListView1.ColumnHeaders.Add(, , "标题2", 1000)
Set clm = ListView1.ColumnHeaders.Add(, , "标题3", 1000)
Set clm = ListView1.ColumnHeaders.Add(, , "标题4", 1000)
Set clm = ListView1.ColumnHeaders.Add(, , "标题5", 1000)
Set clm = ListView1.ColumnHeaders.Add(, , "标题6", 1000)
Set clm = ListView1.ColumnHeaders.Add(, , "标题7", 1000)
Set clm = ListView1.ColumnHeaders.Add(, , "标题8", 1000)
Set clm = ListView1.ColumnHeaders.Add(, , "标题9", 1000)
ListView1.Refresh
'***************************************************************************
i = 1
Do While Not adoRes.EOF
Dim newItem As ListItem
Set newItem = ListView1.ListItems.Add(, , adoRes.Fields(0))
'******************** 如果你的栏位有规则的话用For...Next多舒服
'For j = 1 To 8
' newItem.SubItems(j) = adoRes.Fields(j)
'Next j
'********************
newItem.SubItems(1) = adoRes.Fields(1) 'adoRes!jobaddr
newItem.SubItems(2) = adoRes.Fields(2) 'adoRes!Phone
newItem.SubItems(5) = adoRes.Fields(5) 'adoRes!birth
newItem.SubItems(6) = adoRes.Fields(6) 'adoRes!Type
newItem.SubItems(7) = adoRes.Fields(7) 'adoRes!code
newItem.SubItems(8) = adoRes.Fields(8) 'adoRes!job
newItem.SubItems(4) = adoRes.Fields(4) 'adoRes!mobile
newItem.SubItems(3) = adoRes.Fields(3) 'adoRes!email
If Not adoRes.EOF Then adoRes.MoveNext
If adoRes.EOF Then Exit Do
Loop
adoRes.Close
Command1.Enabled = IIf(adoRes.RecordCount > 0, True, False)
End Sub

[cbm6666]

最下面倒数第二行
Command1.Enabled = IIf(adoRes.RecordCount > 0, True, False)

换到这里
adoRes.Open strSel, adoConn, adOpenKeyset, adLockPessimistic '打开记录集
If adoRes.RecordCount > 0 Then adoRes.MoveFirst
Command1.Enabled = IIf(adoRes.RecordCount > 0, True, False)

[cbm6666]

晕倒... 你的是
If nameCount = 0 Then
Command1.Enabled = True
Else
End If

如果照你的代码来看,如你的记录笔数=0 则 Command1.Enabled = True

所以这行
Command1.Enabled = IIf(adoRes.RecordCount > 0, True, False)
改为
Command1.Enabled = IIf(adoRes.RecordCount = 0, True, False)

[meiZiNick]

不知,帮顶