问MS Excel SQL无法连接到数据库错误句柄

EN

Function GetTestConnectionString() As String

'==================== ' Connection to SQl Server '==============
   GetTestConnectionString = OleDbConnectionString("servername", "db name", "user", "pass")
'===============================================================

End Function
Function GetTestQuery() As String

'==================== ' Get User table ' =======================
    GetTestQuery = "SELECT * FROM [dbname].dbo.Users"
    ' GetTestQuery = "EXEC dbo04.uspExcelTest"
'===============================================================

End Function
'=====================================================
Sub TestImportUsingQueryTable()

    Dim conString As String
    conString = GetTestConnectionString()

    Dim query As String
    query = GetTestQuery()

    Dim Target As Range
    Set Target = ThisWorkbook.Worksheets("AdminPanel2").Cells(10, 2)
    Select Case ImportSQLtoQueryTable(conString, query, Target)
        Case Else
    End Select
End Sub
'======================================================
' ===== QueryTable Functions =====
Sub RefreshWorksheetQueryTables(ByVal ws As Worksheet)

    On Error Resume Next

    Dim qt As QueryTable

    For Each qt In ws.QueryTables
        qt.Refresh BackgroundQuery:=True
    Next

    Dim lo As ListObject

    For Each lo In ws.ListObjects
        lo.QueryTable.Refresh BackgroundQuery:=True
    Next

End Sub
'==================================================================================================================
Function GetTopQueryTable(ByVal ws As Worksheet) As QueryTable

    On Error Resume Next

    Set GetTopQueryTable = Nothing

    Dim lastRow As Long
    lastRow = 0

    Dim qt As QueryTable
    For Each qt In ws.QueryTables
        If qt.ResultRange.row > lastRow Then
            lastRow = qt.ResultRange.row
            Set GetTopQueryTable = qt
        End If
    Next

    Dim lo As ListObject

    For Each lo In ws.ListObjects
        If lo.SourceType = xlSrcQuery Then
            If lo.QueryTable.ResultRange.row > lastRow Then
                lastRow = lo.QueryTable.ResultRange.row
                Set GetTopQueryTable = lo.QueryTable
            End If
        End If
    Next

End Function
'==================================================================================================================
' ===== Connection String Functions =====
Function OleDbConnectionString(ByVal Server As String, ByVal Database As String, _
    ByVal username As String, ByVal Password As String) As String

    If username = "" Then
        OleDbConnectionString = "Provider=SQLOLEDB.1;Data Source=" & Server _
            & ";Initial Catalog=" & Database _
            & ";Integrated Security=SSPI;Persist Security Info=False;"
    Else
        OleDbConnectionString = "Provider=SQLOLEDB.1;Data Source=" & Server _
            & ";Initial Catalog=" & Database _
            & ";User ID=" & username & ";Password=" & Password & ";"

    End If

End Function
'==================================================================================================================
Function OdbcConnectionString(ByVal Server As String, ByVal Database As String, _
    ByVal username As String, ByVal Password As String) As String

    If username = "" Then
        OdbcConnectionString = "Driver={SQL Server};Server=" & Server _
            & ";Trusted_Connection=Yes;Database=" & Database
    Else
        OdbcConnectionString = "Driver={SQL Server};Server=" & Server _
            & ";UID=" & username & ";PWD=" & Password & ";Database=" & Database
    End If

End Function
'==================================================================================================================
Function StringToArray(Str As String) As Variant

    Const StrLen = 127
    Dim NumElems As Integer
    Dim Temp() As String
    Dim i As Integer

    NumElems = (Len(Str) / StrLen) + 1
    ReDim Temp(1 To NumElems) As String

    For i = 1 To NumElems
       Temp(i) = Mid(Str, ((i - 1) * StrLen) + 1, StrLen)
    Next i

    StringToArray = Temp

End Function

'==================================================================================================================
' ===== Import Using QueryTable =====
Function ImportSQLtoQueryTable(ByVal conString As String, ByVal query As String, _
    ByVal Target As Range) As Integer

    On Error Resume Next

    Dim ws As Worksheet
    Set ws = Target.Worksheet

    Dim address As String
    address = Target.Cells(1, 1).address

    ' Procedure recreates ListObject or QueryTable

    If Not Target.ListObject Is Nothing Then     ' Created in Excel 2007 or higher
        Target.ListObject.Delete
    ElseIf Not Target.QueryTable Is Nothing Then ' Created in Excel 2003
        Target.QueryTable.ResultRange.Clear
        Target.QueryTable.Delete
    End If

    If Application.Version >= "12.0" Then        ' Excel 2007 and higher
        With ws.ListObjects.Add(SourceType:=0, Source:=Array("OLEDB;" & conString), _
            Destination:=Range(address))

            With .QueryTable
                .CommandType = xlCmdSql
                .CommandText = StringToArray(query)
                .BackgroundQuery = True
                .SavePassword = True
                .Refresh BackgroundQuery:=False
            End With
        End With
    Else                                          ' Excel 2003
        With ws.QueryTables.Add(Connection:=Array("OLEDB;" & conString), _
            Destination:=Range(address))

            .CommandType = xlCmdSql
            .CommandText = StringToArray(query)
            .BackgroundQuery = True
            .SavePassword = True
            .Refresh BackgroundQuery:=False
        End With
    End If

    ImportSQLtoQueryTable = 0


End Function
'==================================================================================================================
'==================================================================================================================