我编写了下面的vba函数来查询名为Nelus
的sql数据库和一个名为ShareName
的表。该表有两列,ShortCode
和Name
。该函数将公司代码作为参数,例如"c01"
,并应返回公司名称,例如"company01"
。
Sub
运行时,它可以工作(在下面的代码中注释掉)。 Function
运行时,如下所示,它会返回'0'
的值,而不是"company01"
。 有关如何让它作为函数运行的任何建议吗?谢谢! Nelus
'Sub TestSQLQuery()
Function ShareInfo(CompCode As String)
Dim SQL As String
Dim RS As ADODB.Recordset
Dim Field As ADODB.Field
'Dim CompCode As String
Dim Server, Database As String
Dim Connect As Boolean
'CompCode = "c01"
SQL = "select p.[Name]" & _
"from dbo.['ShareName'] p " & _
"where p.ShortCode = '" & CompCode & "' "
Server = "npc\SQLEXPRESS"
Database = "Nelus"
Set CN = New ADODB.Connection
On Error Resume Next
With CN
.ConnectionString = "Provider=SQLOLEDB.1;" & _
"Integrated Security=SSPI;" & _
"Server=" & Server & ";" & _
"Database=" & Database & ";"
.Open
End With
If CN.State = 0 Then
Connect = False
Else
Connect = True
End If
If Connect = False Then
MsgBox "Could Not Connect!"
Else
Set RS = New ADODB.Recordset
RS.Open SQL, CN, adOpenStatic, adLockReadOnly, adCmdText
If RS.State Then
Cells(ActiveCell.Row, ActiveCell.Column).CopyFromRecordset RS
Set RS = Nothing
End If
CN.Close
End If
End Function
'End Sub
答案 0 :(得分:1)
使用Do While Not RS.EOF
完成重新设置并获得结果。在你的情况下,它可能应该是一个或没有记录?然后将记录集的结果分配给函数名ShareInfo = RS.fields(nameColumnIndex).value
。因此,该函数将其返回给调用过程,在调用过程中可以进一步使用它。比如Cells(ActiveCell.row, ActiveCell.column).value = companyName
。 HTH
注意:这适用于您吗? from dbo.['ShareName']
。 使徒似乎不正确。
Sub test()
Dim companyCode As String
Dim companyName As String
companyCode = "c01"
companyName = ShareInfo(companyCode)
If Not companyName = "" Then
Cells(ActiveCell.row, ActiveCell.column).value = companyName
Else
MsgBox "Company name not found for code '" & companyCode & "'.", vbExclamation
End If
End Sub
Function ShareInfo(CompCode As String) As String
Dim SQL As String
Dim RS As ADODB.Recordset
Dim CN As ADODB.Connection
Dim Field As ADODB.Field
Dim Server, Database As String
Dim Connect As Boolean
ShareInfo = ""
SQL = "select p.[Name]" & _
"from dbo.[ShareName] p " & _
"where p.ShortCode = '" & CompCode & "' "
Server = "npc\SQLEXPRESS"
Database = "Nelus"
Set CN = New ADODB.Connection
On Error Resume Next
With CN
.ConnectionString = "Provider=SQLOLEDB.1;" & _
"Integrated Security=SSPI;" & _
"Server=" & Server & ";" & _
"Database=" & Database & ";"
.Open
End With
If CN.State = 0 Then
Connect = False
Else
Connect = True
End If
If Connect = False Then
MsgBox "Could Not Connect!"
Else
Set RS = New ADODB.Recordset
RS.Open SQL, CN, adOpenStatic, adLockReadOnly, adCmdText
Const nameColumnIndex As Integer = 0
Dim i As Integer
If RS.State Then
Do While Not RS.EOF
i = i + 1
ShareInfo = RS.fields(nameColumnIndex).value
RS.MoveNext
Loop
End If
RS.Close
CN.Close
If i > 1 Then _
MsgBox "More then one company name found for code '" & CompCode & "'.", vbExclamation
End If
End Function