请帮忙看看这段代码错在哪里?老提示无法找到数据源
Public Sub main()
If App.PrevInstance = True Then
MsgBox "程序已经运行,无法再次执行.", vbOKOnly + vbInformation, "系统提示"
End
End If ConnStr = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=cbxx;Data Source=ZSM2"
App.HelpFile = App.Path & "\help.chm"
Load sfck
sfck.Show
End Sub
Public Function ExeSQL(ByVal sql As String) As ADODB.Recordset
On Error GoTo ErrHandler:
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strArray() As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
strArray = Split(sql)
cn.Open ConnStr
If StrComp(UCase$(strArray(0)), "select", vbTextCompare) = 0 Then
rs.Open Trim$(sql), cn, adOpenKeyset, adLockOptimistic
Set ExeSQL = rs
Else
cn.Execute sql
End IfExeSQl_Exit:
Set rs = Nothing
Set cn = Nothing
Exit Function
ErrHandler:
' 显示错误信息
MsgBox "错误号:" & Err.Number & " 错误信息:" & Err.Description, vbExclamation
Resume ExeSQl_Exit
End FunctionDim sqlFindJH, sqlFindJH2 As StringIf gsh.Text = "" Then
MsgBox "请输入给水号", vbExclamation + vbOKOnly, "系统提示"
Exit Sub
End IfDim rs As ADODB.Recordset
sqlFindJH = "select DECE_ONE from user_js1 where DECE_ONE='" & Trim(gsh.Text) & "'"
Set rs = ExeSQL(sqlFindJH)Dim rsjh As ADODB.Recordset
sqlFindJH2 = "select * from user_js1 where DECE_ONE='" & Trim(gsh.Text) & "'"
Set rsjh = ExeSQL(sqlFindJH2)
yhmc = rsjh("NAME")
scjl = rsjh("LAST_DATA")
zcjl = rsjh("THIS_DATA")
Public Sub main()
If App.PrevInstance = True Then
MsgBox "程序已经运行,无法再次执行.", vbOKOnly + vbInformation, "系统提示"
End
End If ConnStr = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=cbxx;Data Source=ZSM2"
App.HelpFile = App.Path & "\help.chm"
Load sfck
sfck.Show
End Sub
Public Function ExeSQL(ByVal sql As String) As ADODB.Recordset
On Error GoTo ErrHandler:
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strArray() As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
strArray = Split(sql)
cn.Open ConnStr
If StrComp(UCase$(strArray(0)), "select", vbTextCompare) = 0 Then
rs.Open Trim$(sql), cn, adOpenKeyset, adLockOptimistic
Set ExeSQL = rs
Else
cn.Execute sql
End IfExeSQl_Exit:
Set rs = Nothing
Set cn = Nothing
Exit Function
ErrHandler:
' 显示错误信息
MsgBox "错误号:" & Err.Number & " 错误信息:" & Err.Description, vbExclamation
Resume ExeSQl_Exit
End FunctionDim sqlFindJH, sqlFindJH2 As StringIf gsh.Text = "" Then
MsgBox "请输入给水号", vbExclamation + vbOKOnly, "系统提示"
Exit Sub
End IfDim rs As ADODB.Recordset
sqlFindJH = "select DECE_ONE from user_js1 where DECE_ONE='" & Trim(gsh.Text) & "'"
Set rs = ExeSQL(sqlFindJH)Dim rsjh As ADODB.Recordset
sqlFindJH2 = "select * from user_js1 where DECE_ONE='" & Trim(gsh.Text) & "'"
Set rsjh = ExeSQL(sqlFindJH2)
yhmc = rsjh("NAME")
scjl = rsjh("LAST_DATA")
zcjl = rsjh("THIS_DATA")
你的程序运行到 cn.open那一行时,connstr是否为空?设断点看看。
你先用ODBC连接一下数据库看看是否可以连接通,如果ODBC都不能连通的话,估计是机器的问题,如:防火墙关掉试试,例外中添加1433端口试试
如果ODBC连通了就检查代码看看是否connstr没有值
.....
....
...
..
.