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