VBA宏将SQL错误代码复制到Excel中

Question

I am trying to write/adopt a macro in VBA to copy a SQL query into Excel. I have it connecting and executing. When I run it manually in SQL, this is the error code in SQL:

Msg 3701, Level 11, State 5, Line 1
Cannot drop the table '#MSP_History3', because it does not exist or you do not have permission.

(8661 row(s) affected)
Msg 3701, Level 11, State 5, Line 1
Cannot drop the table '#MSP1', because it does not exist or you do not have permission.

(8661 row(s) affected)
Msg 3701, Level 11, State 5, Line 1
Cannot drop the table '#MSP_PBP', because it does not exist or you do not have permission.

(8661 row(s) affected)
Msg 3701, Level 11, State 5, Line 1
Cannot drop the table 'dbo.MSP_History', because it does not exist or you do not have permission.
Msg 262, Level 14, State 1, Line 1
CREATE TABLE permission denied in database 'master'.

Looks like its not a great query, but what interests me is the number of rows affected.

Here is the latter portion of the VBA code that someone more skilled than me had used for a different query that works to paste the table result in A1:

'Open the connection.
cn.Open strConn
'
'Set and Execute SQL Command
Set cmd1.ActiveConnection = cn
cmd1.CommandText = SQLquery
cmd1.CommandType = adCmdText
cmd1.Execute

'Open Recordset
Set rs1.ActiveConnection = cn
rs1.Open cmd1

'Paste Column Headers into Spreadsheet
    For Col = 0 To rs1.Fields.Count - 1
    Range("A1").Offset(0, Col).Value = rs1.Fields(Col).Name
    Next

'Copy Data to Excel
ActiveSheet.Range("A2").CopyFromRecordset rs1
Cells.Select
Cells.EntireColumn.AutoFit

This code works for a properly-executed SQL query. Is there a way to copy the error message?

Ideally what I want in cell A1 in Excel is just "8661".

Thanks!

edit: Currently the error message in VBA upon executing the "cmd1.Execute" line is:

Run-time error '-2147217900 (80040e14)': Automation error

Answer 1

Maybe you can try with this code... It shows the error on a message box.

Option Explicit

Public Sub Connect()

On Error GoTo InvalidValue:

Dim myCn As MyServer
Set myCn = New MyServer

Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

rs.Open "Select * from myTable", myCn.GetConnection

Range("A1").CopyFromRecordset rs

rs.Close
myCn.Shutdown

Set rs = Nothing
Set myCn = Nothing

Exit Sub

InvalidValue:

MsgBox Err.Number & " " & Err.Description

End Sub