VBs讀取SQLserver數據庫，並寫值到excel中

Dim t
'獲取系統當前時間
t=Year(Now)&"."&Month(Now)&"."&Day(Now)&"-"&Hour(Now)&"."&Minute(Now)&"."&Second(Now)
Dim filename,sheetname ,xlApp, xlWorkbook, xlWorksheet  
Dim i,constr,con,rst,iRowCount,sql
    
  constr="Provider=SQLOLEDB.1;Password=pwd;Persist Security Info=True;User ID=userName;Initial Catalog=databaseName;Data Source=127.0.0.1"   '如果是wincc在鏈接ip后面加    \wincc
Set con = CreateObject("ADODB.Connection")
    con.ConnectionString = constr
    con.Open

     
 If Con.State = 0 Then      '判斷數據庫連接是否成功
     ' MsgBox "連接數據庫失敗"
 Else
      MsgBox "連接數據庫成功"
 End If
'打開excel表
Set xlApp=CreateObject("Excel.Application")
 Set xlWorkBook=xlApp.Workbooks.Add
     xlApp.Visible=True
     xlApp.Sheets.Item(1).Name="ERS點"   '設置第一個sheet名字
 Set xlWorksheet=xlApp.Sheets.Item(1)
'寫入列名字
xlWorksheet.Range("B1").Value ="X"
xlWorksheet.Range("C1").Value="Y"
xlWorksheet.Range("D1").Value="Z"
'xlWorksheet.Range("A1").Value="ID"
xlWorksheet.Range("A1").Value="點名"
xlWorksheet.Range("E1").Value="X1"
xlWorksheet.Range("F1").Value="Y1"
xlWorksheet.Range("G1").Value="Z1"

'查詢
Set rst=  CreateObject("ADODB.Recordset") 
 sql="select * from initial_coordinates"
      rst.open sql,con,1,3,1
       iRowCount = rst.recordcount  ‘統計查詢到的的數據量
'Msgbox iRowCount
'寫值到excel
For i=2 To iRowCount+1
 xlWorksheet.Range("A" & i).Value= rst(1)
 xlWorksheet.Range("B" & i).Value= rst(2)
 xlWorksheet.Range("C" & i).Value= rst(3)
 xlWorksheet.Range("D" & i).Value= rst(4)
 xlWorksheet.Range("E" & i).Value= rst(5)
 xlWorksheet.Range("F" & i).Value= rst(6)
 xlWorksheet.Range("G" & i).Value= rst(7)

rst.movenext
Next
xlApp.ActiveWorkbook.SaveAs("d:\ERS點數據"+ t +".xls")
MsgBox "導出數據成功！"
 If con.state Then con.Close   '關閉數據連接
 Set xlWorkBook=Nothing
 Set xlApp=Nothing