Question

我正在尝试连接到SQL Server并使用特定日期范围提取某些数据，以便用户只需添加他们想要提取的年份，它就会获得该年的所有数据。

该查询在SQL中有效，但只要我将其添加到VBA，它就什么也不做。有人可以帮助或向我解释原因吗？

目前我可以连接到数据库并且我的数据记录有效，因为如果我使用较小的查询，它可以正常工作。

Option Explicit

Sub ADOExcelSQLServer()

    Dim conn As ADODB.Connection

    Dim Server_Name As String
    Dim Database_Name As String
    Dim User_ID As String
    Dim Password As String

    Dim Data As ADODB.Recordset

    Server_Name = "******" ' Enter your server name here
    Database_Name = "******" ' Enter your database name here
    User_ID = "*****" ' enter your user ID here
    Password = "*****" ' Enter your password here

    Set conn = New ADODB.Connection
    Set Data = New ADODB.Recordset

    conn.ConnectionString = "Provider=SQLNCLI10;Server=" & Server_Name & ";Database=" & Database_Name & ";Uid=" & User_ID & ";Pwd=" & Password & ";"

    conn.Open

    On Error GoTo CloseConnection

    With Data
    .ActiveConnection = conn
    .Source = GetYearString
    .LockType = adLockReadOnly
    .CursorType = adOpenForwardOnly
    .Open
    End With

    Sheets("Sheet3").Range("D4:O4").CopyFromRecordset Data

    On Error GoTo 0

    Data.Close

CloseConnection:
    conn.Close

End Sub

Function GetYearString() As String
    Dim Year As Integer
    Dim SQLString As String
    Year = Application.InputBox("Enter the Year of choice ?", Type:=1)
    SQLString = "DECLARE @Test TABLE"
    SQLString = SQLString & "("
    SQLString = SQLString & "ID INT IDENTITY(1,1),"
    SQLString = SQLString & "Value Float"
    SQLString = SQLString & ")"
    SQLString = SQLString & "DECLARE @InputDate DATETIME"
    SQLString = SQLString & "SET @InputDate = '" & Year & "-01-01'"
    SQLString = SQLString & "WHILE @InputDate <= CAST('" & Year & "-12-01' AS DATETIME)"
    SQLString = SQLString & "BEGIN"
    SQLString = SQLString & "DECLARE @MonthStartDate DATETIME"
    SQLString = SQLString & "SELECT @MonthStartDate = CAST(DATEADD(dd, - DATEPART(dd, @InputDate) + 1, @InputDate)AS DATETIME)"
    SQLString = SQLString & "INSERT INTO @Test"
    SQLString = SQLString & "SELECT MAX([Value])*2 FROM DataLog2"
    SQLString = SQLString & "WHERE DateAdd(HOUR,2,TimestampUTC) >= @MonthStartDate AND DateAdd(HOUR,2,TimestampUTC) < DATEADD(DAY,1,@MonthStartDate) AND SourceID = 26 AND quantityid = 129"
    SQLString = SQLString & "SET @InputDate = DATEADD(MONTH, 1, @InputDate)"
    SQLString = SQLString & "End"
    SQLString = SQLString & "SELECT Value FROM @Test"
    GetYearString = SQLString
End Function

Answer 1

你在SQL字符串构造中犯了两个错误：

你忘记了新行
混合SQL和变量

第一个很容易修复。我更喜欢以下方法在VBA中创建多行字符串：

str = Join(Array( _
    "line", _
    "line", _
    "line" _
), vbNewLine)

第二个错误是SQL注入漏洞的主要原因，作为一个原则问题，你绝对不应该使用字符串连接来构建变量SQL。

此ADODB.Command对象存在。它采用带有?占位符和单独查询参数的固定字符串。它将查询和参数组合在一起，使您无需担心转义并同时具有类型安全性。

Option Explicit

Dim conn As New ADODB.Connection

Sub ConnectSqlServer()
    Dim Server_Name As String
    Dim Database_Name As String
    Dim User_ID As String
    Dim Password As String

    Server_Name = "******" ' Enter your server name here
    Database_Name = "******" ' Enter your database name here
    User_ID = "*****" ' enter your user ID here
    Password = "*****" ' Enter your password here

    conn.ConnectionString = "Provider=SQLNCLI10;Server=" & Server_Name & ";Database=" & Database_Name & ";Uid=" & User_ID & ";Pwd=" & Password & ";"
    conn.Open
End Sub

Sub FillSheet()
    Dim year As Integer

    If conn.State <> adStateOpen Then ConnectSqlServer()

    year = Application.InputBox("Enter the Year of choice ?", Type:=1)

    If year > 0 Then
        Sheets("Sheet3").Range("D4:O4").CopyFromRecordset GetYear(year)
    End If
End Sub

Function GetYear(year As Integer) As ADODB.Recordset
    ' TODO add a check for "conn Is Nothing"
    ' TODO add a check for "conn.State <> adStateOpen"
    With New ADODB.Command
        Set .ActiveConnection = conn
        .ActiveConnection.CursorLocation = adUseClient

        .CommandType = adCmdText
        .CommandText = Join(Array( _
            "DECLARE @Test TABLE (", _
                "ID INT IDENTITY(1, 1),", _
                "Value Float", _
            ")", _
            "DECLARE @year INT", _
            "DECLARE @InputDate DATETIME", _
            "DECLARE @MonthStartDate DATETIME", _
            "SET year = ?", _
            "SET @InputDate = CAST(@year + '-01-01' AS DATETIME)", _
            "WHILE @InputDate <= CAST(@year + '-12-01' AS DATETIME)", _
            "BEGIN", _
                "SELECT @MonthStartDate = CAST(DATEADD(dd, - DATEPART(dd, @InputDate) + 1, @InputDate)AS DATETIME)", _
                "INSERT INTO @Test", _
                "SELECT MAX([Value])*2 FROM DataLog2", _
                "WHERE DateAdd(HOUR,2,TimestampUTC) >= @MonthStartDate AND DateAdd(HOUR,2,TimestampUTC) < DATEADD(DAY,1,@MonthStartDate) AND SourceID = 26 AND quantityid = 129", _
                "SET @InputDate = DATEADD(MONTH, 1, @InputDate)", _
            "END", _
            "SELECT Value FROM @Test" _
        ), vbNewLine)

        .Parameters.Append .CreateParameter(Type:=adInteger, Value:=year)

        Set GetYear = .Execute ' .Execute() will always return an adLockReadOnly|adOpenForwardOnly RS
    End With
End Function

P.S。：@ SeanLange的评论是正确的，您的SQL不应包含INSERT的while循环。您应该将其修改为基于集合的语句。

VBA查询不返回值

1 个答案: