我需要将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