VBA 运行时错误“1004”

Question

我正在尝试使用 VBA 将 SQL 存储过程生成的数据附加到我的 excel 电子表格中现有数据的末尾。我希望它粘贴到最后一列的右侧。每次我运行它时，我都会收到上面的错误：“对象'_Global'的方法'范围'失败。

我希望将新数据粘贴到现有数据右侧的第 3 行。以下是我的 vba 代码：

Sub RefreshStatus()
    Dim db As DAO.Database
    Dim con As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim StoredProc As String
    Dim RWS As Worksheet
    Dim DWS As Worksheet
    Dim ServerName As String
    Dim DatabaseName As String
    Dim StoredProcedure As String

    Set con = New ADODB.Connection
    Set cmd = New ADODB.Command
    Set rs = New ADODB.Recordset
    Set RWS = Worksheets("Refresh")
    Set DWS = Worksheets("141215")




    Application.DisplayStatusBar = True
    Application.StatusBar = "Contacting SQL Server..."


    RWS.Activate

    ServerName = "tns-reports-01" ' Enter your server name here
    DatabaseName = "GroupPerformance" ' Enter your database name here
    StoredProcedure = "JM_Recruitment_Status_141215" ' Enter Stored Procedure here

    con.Open "Provider=SQLOLEDB;Data Source=" & ServerName & ";Initial Catalog=" & DatabaseName & ";Trusted_Connection=yes"
    cmd.ActiveConnection = con


    Application.StatusBar = "Running stored procedure..."
    cmd.CommandTimeout = 0
    cmd.CommandText = StoredProcedure
    Set rs = cmd.Execute(, , adCmdStoredProc)


     ' Copy the results to cell A1 on the first Worksheet
    DWS.Activate

    Dim Lastcol As Long

    Lastcol = Range("3" & Columns.Count).End(xlRight).Row

    If rs.EOF = False Then DWS.Cells(2, 1).CopyFromRecordset rs



    rs.Close
    Set rs = Nothing
    Set cmd = Nothing


    con.Close
    Set con = Nothing

    Application.StatusBar = "Data successfully updated."

End Sub

如果有人可以帮助我，我将不胜感激。

非常感谢。

Answer 1

您在尝试查找最后一个非空列时出现了一些错误以及其他一些小错误。

以下是您的代码，有一些更改（更改在 cmets 中进行了描述）。

我假设您的记录集只包含一个字段和许多记录，并且 您想将所有这些记录从单元格 _3 水平粘贴到右侧，其中 _ 是第一个空列。

Sub RefreshStatus()
    Dim db As DAO.Database
    Dim con As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim StoredProc As String
    Dim RWS As Worksheet
    Dim DWS As Worksheet
    Dim ServerName As String
    Dim DatabaseName As String
    Dim StoredProcedure As String

    Set con = New ADODB.Connection
    Set cmd = New ADODB.Command
    Set rs = New ADODB.Recordset
    Set RWS = Worksheets("Refresh")
    Set DWS = Worksheets("141215")



    With Application
        .DisplayStatusBar = True
        .StatusBar = "Contacting SQL Server..."
    End With


    'NOTE: You don't have to activate worksheet to operate on its ranges.
    'Actually, you shouldn't do that, since it's time-consuming, make the
    'user experience worst and can cause errors in specific cases.
    'Additionaly, I can't see where you use RWS worksheet later in the code.
    'RWS.Activate

    ServerName = "tns-reports-01" ' Enter your server name here
    DatabaseName = "GroupPerformance" ' Enter your database name here
    StoredProcedure = "JM_Recruitment_Status_141215" ' Enter Stored Procedure here

    con.Open "Provider=SQLOLEDB;Data Source=" & ServerName & ";Initial Catalog=" & DatabaseName & ";Trusted_Connection=yes"
    cmd.ActiveConnection = con


    Application.StatusBar = "Running stored procedure..."
    cmd.CommandTimeout = 0
    cmd.CommandText = StoredProcedure
    Set rs = cmd.Execute(, , adCmdStoredProc)


    ' Copy the results to cell A1 on the first Worksheet
    'Again, it is not necessary to activate worksheet.
    'DWS.Activate


    Dim lastCol As Long


    'If rs.EOF = False Then DWS.Cells(2, 1).CopyFromRecordset rs
    row = 3
    lastCol = DWS.Cells(row, DWS.Columns.Count).End(xlRight).Column + 1
    Do Until rs.EOF
        DWS.Cells(row, lastCol).value = rs.Fields(0).value
        row = row + 1
        Call rs.MoveNext
    Loop



    rs.Close
    Set rs = Nothing
    Set cmd = Nothing


    con.Close
    Set con = Nothing

    Application.StatusBar = "Data successfully updated."

End Sub