將Excel導出到SQL VBA：找不到存儲過程

Question

我試圖通過VBA自動將數據從excel導出到SQL。 我對VBA的了解不多，Excel告訴我以下錯誤（請參見下文）。 我應該在哪里創建該程序？ 在SQL中？ 那應該如何設計？ （以下代碼中的xxx，我把它們放了）

Sub testexportsql()
    Dim cn As ADODB.connection
    Dim ServerName As String
    Dim DatabaseName As String
    Dim TableName As String
    Dim UserID As String
    Dim Password As String
    Dim rs As ADODB.recordset
    Dim RowCounter As Long
    Dim NoOfFields As Integer
    Dim StartRow As Long
    Dim EndRow As Long
    Dim ColCounter As Integer

    Set rs = New ADODB.recordset

    ServerName = "xxx" ' Enter your server name here
    DatabaseName = "DATAWAREHOUSE" ' Enter your  database name here
    TableName = "dbo.AlbertaFire_import" ' Enter your Table name here
    UserID = "sa" ' Enter your user ID here
    ' (Leave ID and Password blank if using windows Authentification")
    Password = "xxx" ' Enter your password here
    NoOfFields = 331 ' Enter number of fields to update (eg. columns in your worksheet)
    StartRow = 2 ' Enter row in sheet to start reading  records
    EndRow = 200 ' Enter row of last record in sheet

     '  CHANGES
    Dim shtSheetToWork As Worksheet
    Set shtSheetToWork = ActiveWorkbook.Worksheets("Sheet2")
     '********

    Set cn = New ADODB.connection

    cn.Open "Driver={SQL Server};Server=" & ServerName & ";Database=" & DatabaseName & _
    ";Uid=" & UserID & ";Pwd=" & Password & ";"

    rs.Open TableName, cn, adOpenKeyset, adLockOptimistic

     'EndRow = shtSheetToWork.Cells(Rows.Count, 1).End(xlUp).Row
    For RowCounter = StartRow To EndRow
        rs.AddNew
        For ColCounter = 1 To NoOfFields
        'On Error Resume Next
            rs(ColCounter - 1) = shtSheetToWork.Cells(RowCounter, ColCounter)
        Next ColCounter
        Debug.Print RowCounter
    Next RowCounter
    rs.UpdateBatch

     ' Tidy up
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

---

rs.Open TableName, cn, adOpenKeyset, adLockOptimistic

運行時錯誤'-2147217900（80040e14）'：
[Microsoft] [OBDC SQL服務器驅動程序] [SQL Server]找不到存儲過程'dbo.AlbertaFire_import'

Answer 1

我試圖重現該錯誤。 只要SQL服務器上的表存在，代碼就可以正常工作。 如果該表不存在，則會得到相同的錯誤代碼，但描述為“ automation-error”。

我猜該表在您的服務器上不存在。 創建表AlbertaFire_import並嘗試。 如果可行，則可能需要在導入新數據之前刪除舊記錄。 您可以使用“執行”一些SQL來做到這一點：

cn.Open "Driver={SQL Server};Server=" & ServerName & ";Database=" & DatabaseName & ";Uid=" & UserID & ";Pwd=" & Password & ";"

cn.Execute "delete from " + TableName

rs.Open TableName, cn, adOpenKeyset, adLockOptimistic

希望對您有幫助...

Answer 2

有幾種方法可以執行這樣的操作。

Sub sql_login()

    '******************************************************
    ' Connection info to log into SQL Server
    '******************************************************
    Dim ServerName As String
    Dim dbname As String
    Dim uname As String
    Dim pword As String

    ServerName = "your_server_name"
    dbname = "Northwind"
    'uname = "**************"
    'pword = "**************"

    '******************************************************
    ' Calls the SQLConnect to query batch information
    '******************************************************
    Call SQLConnect(ServerName, dbname) ', uname, pword)

End Sub


Sub SQLConnect(ServerName As String, dbname As String) ', uname As String, pword As String)
    '******************************************************
    ' Logs into SQL Server to get actual batch information
    '******************************************************
    Dim Cn As adodb.Connection
    Set Cn = New adodb.Connection

    'On Error GoTo ErrHand
        With Cn
            .ConnectionString = "your_server_name;Database=Northwind;Trusted_Connection=True;"
        End With

    '******************************************************
    ' Calls the the SQL Query
    '******************************************************
    Call sql_query(Cn)

End Sub


Sub sql_query(Cn As adodb.Connection)

    '******************************************************
    ' Performs SQL Query
    '******************************************************
    Dim RS As adodb.Recordset
    Dim sqlString As String
    Set RS = New adodb.Recordset

    sqlString = "Select * From Northwind.dbo.TBL"
    RS.Open sqlString, Cn, adOpenStatic, adLockOptimistic
    Cn.Execute (sqlString)

    Dim fld As adodb.Field

    '******************************************************
    ' Create Field Headers for Query Results
    '******************************************************
    i = 0
    With Worksheets("sheet1").Range("A1")
        For Each fld In RS.Fields
            .Offset(0, i).Value = fld.Name
            i = i + 1
        Next fld
    End With

    '******************************************************
    ' Copy Query Results into Excel
    '******************************************************
    Worksheets("sheet1").Range("A1").CopyFromRecordset RS

End Sub

要么 。 。 。

Sub InsertInto()

'Declare some variables
Dim cnn As adodb.Connection
Dim cmd As adodb.Command
Dim strSQL As String

'Create a new Connection object
Set cnn = New adodb.Connection

'Set the connection string
cnn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=Northwind;Data Source=your_server_name"
'cnn.ConnectionString = "DRIVER=SQL Server;SERVER=your_server_name;DATABASE=Northwind;Trusted_Connection=Yes"


'Create a new Command object
Set cmd = New adodb.Command

'Open the Connection to the database
cnn.Open

'Associate the command with the connection
cmd.ActiveConnection = cnn

'Tell the Command we are giving it a bit of SQL to run, not a stored procedure
cmd.CommandType = adCmdText

'Create the SQL
strSQL = "UPDATE TBL SET JOIN_DT = '2013-01-22' WHERE EMPID = 2"

'Pass the SQL to the Command object
cmd.CommandText = strSQL


'Execute the bit of SQL to update the database
cmd.Execute

'Close the connection again
cnn.Close

'Remove the objects
Set cmd = Nothing
Set cnn = Nothing

End Sub

您還可以執行其他一些操作，所有這些都與上述方法有關。