我需要将sql server结果导出到新的excel工作簿吗？

Question

我需要将结果放到新的工作簿中，目前我是否在现有工作簿中获得结果？

Sub ConnectSqlServer()

Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
Dim rsstring As String
Workbooks.Add
ActiveWorkbook.SaveAs "C:\WorkbookName.xls"
sConnString = "Provider=SQLOLEDB;Data Source=PRATEEP-PC\SQLEXPRESS;" & _
              "Initial Catalog=PPDS_20Dec_V1_Decomposition;" & _
              "Integrated Security=SSPI;"
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open sConnString
rsstring = "SELECT * FROM GE_PRODUCT_RESOURCE_MASTER;"
rs.Open rsstring, sConnString
 ActiveSheet.Range("B3").CopyFromRecordset rs 
rs.Close
conn.Close
End Sub

Answer 1

我试过了，它工作得很好。不管怎样都要让它防弹。

Sub ConnectSqlServer()

Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
Dim rsstring As String
Set NewWorkbook = Workbooks.Add 'To avoid ActiveWorkbook
sConnString = "Provider=SQLOLEDB;Data Source=PRATEEP-PC\SQLEXPRESS;" & _
              "Initial Catalog=PPDS_20Dec_V1_Decomposition;" & _
              "Integrated Security=SSPI;"
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open sConnString
rsstring = "SELECT * FROM GE_PRODUCT_RESOURCE_MASTER;"
rs.Open rsstring, sConnString
NewWorkbook.Range("B3").CopyFromRecordset rs 'directly call the NewWorkbook
rs.Close
conn.Close
NewWorkbook.SaveAs "C:\WorkbookName.xls" 'Save after your change
End Sub