Excel excel to 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 SEVER驱动程序] [SQL Server]找不到存储过程'dbo.albertafire_import'

Answer 1

我试图重现错误。只要存在SQL Server上的表，该代码就可以正常工作。如果表不存在，我会得到相同的错误代码，但作为"自动化"描述。

我猜该表不存在您的服务器上。创建表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

您还可以做一些其他事情，所有这些都与上述方法相关。