通过VBA连接到MSSQL的问题

Question

通过VBA连接到MSSQL服务器时出现问题以下是我遇到问题的代码

Set con = New ADODB.Connection
Set rs = New ADODB.Recordset

con.Provider = "sqloledb"
sConnectionString = "Server=SQLServer;Database=DBName;UID=sa;Pwd=NiceTry"
con.Open sConnectionString

'Dim sh As Worksheet
Dim tempSheet As String
tempSheet = "IgnoreMe"

'See if there is already an "IgnoreMe" Sheet, create it if not. 
Dim wsSheet As Worksheet
On Error Resume Next
Set wsSheet = Sheets("IgnoreMe")
On Error GoTo 0
If Not wsSheet Is Nothing Then
    'Sheet exists, don't recreate it.
Else
    Sheets.Add.Name = tempSheet
End If
    Set sh = Worksheets("IgnoreMe")

' Clean up the sheet's contents
sh.UsedRange.Clear

' Now get the table's data
rs.Open "SELECT JobHeaderID, Job, ProofApproved, SleeveLabel, MasterLabel" & _
                     " FROM JobHeader " & _
                     " WHERE Job IN ('665511', '671259', '671259-1')", con



End Sub

这只是下载信息的部分。我有其他代码来读取记录集。在rs.Open行，我总是得到一个Automation Error我无法弄清楚它遇到了什么问题。关于什么打击的任何想法？

我正在尝试关注http://webcheatsheet.com/ASP/database_connection_to_MSSQL.php没有DSN的作品

Answer 1

找到了一个非常简单的例子here

这是我的工作代码已清理

Sub IterateColE()
    ' Clean up the destination sheet's contents
    Sheets("IgnoreMe").UsedRange.Clear


    'We're going to iterate through column E until we hit a blank/empty cell.
    For Each currCell In Worksheets("Main").Range("E:E").Cells()
        'Oh! and we dont want to get the header row
        If currCell.Row  1 Then
            If (currCell.Text  "") And (currCell.Text  vbNullString) Then
                'Get values for job in currCell and place in the matching row on IgnoreMe
                getValues currCell.Value, currCell.Row
            Else
            'Well, seems we've hit a blank cell, stop processing
                Exit For
            End If
        End If
    Next
End Sub

'Gets the needed values for the job and places them in "IgnoreMe" sheet on specified row. They can then be referenced like "=IgnoreMe!C3"
Sub getValues(job As String, destinationRow As Integer)

    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sConnString As String

    ' Create the connection string.
    sConnString = "Provider=SQLOLEDB;Data Source=SQLServer;" & _
                  "Initial Catalog=InitialTableName;" & _
                  "UID=DBUsername;Pwd=Nicetry;"

    ' Create the Connection and Recordset objects.
    Set conn = New ADODB.Connection
    Set rs = New ADODB.Recordset

    ' Open the connection and execute.
    conn.Open sConnString
    Set rs = conn.Execute("SELECT JobHeaderID, Job, DataProofApproved, SleevePackLabel, MasterLabel" & _
                         " FROM JobHeader " & _
                         " WHERE Job='" & job & "'")

    ' Check we have data.
    If Not rs.EOF Then
        ' Transfer result.
        Sheets("IgnoreMe").Range("A" & destinationRow).CopyFromRecordset rs
    ' Close the recordset
        rs.Close
    Else
        MsgBox "Error: No records returned.", vbCritical
    End If

    ' Clean up
    If CBool(conn.State And adStateOpen) Then conn.Close
    Set conn = Nothing
    Set rs = Nothing

End Sub


'Close out your connection when you close the workbook. Locked database tables are annoying
Private Sub Workbook_Deactivate()
    If Not (con Is Nothing) Then
        con.Close
        Set con = Nothing
    End If
End Sub