使用VBA函数查询SQL

时间:2014-12-28 11:36:54

标签: sql vba function

我编写了下面的vba函数来查询名为Nelus的sql数据库和一个名为ShareName的表。该表有两列,ShortCodeName。该函数将公司代码作为参数,例如"c01",并应返回公司名称,例如"company01"

  • 当我将vba代码作为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

1 个答案:

答案 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