如何掉以前的归档

Dim sPro 
 Dim sDsn 
 Dim sSer 
 Dim sCon 
 Dim sSql 
 Dim oRs 
 Dim conn 
 Dim oCom 
 Dim oItem 
 Dim m, n, s,i
 Dim hourdate 
 Dim secdate 
 Dim k
 Dim oList
 Dim objExcelApp
 Dim oItem2
 sPro = "Provider=WinCCOLEDBProvider.1;"
 sDsn = "Catalog=CC_0414_08_04_14_20_46_43R;"
 sSer = "Data Source=.\WinCC"
 sCon = sPro + sDsn + sSer
 sSql = "TAG:R,''ProcessValueArchive\NewTag1'',''0000-00-01 00:00:00.000'',''0000-00-00 00:00:00.000''"

 Set conn = CreateObject("ADODB.Connection")
 conn.ConnectionString = sCon
 conn.CursorLocation = 3
 conn.Open
 Set oRs = CreateObject("ADODB.Recordset")
 Set oCom = CreateObject("ADODB.Command")
 oCom.CommandType = 1
 Set oCom.ActiveConnection = conn
 oCom.CommandText = sSql
 Set oRs = oCom.Execute
 ''oRs.MoveFirst
 Set objexcelApp=CreateObject("excel.application")
 objexcelApp.visible=True
 objexcelapp.workbooks.open"d:\book.xls"
 objExcelApp.Sheets(1).Range("a"&Trim(1)) =oRs.Fields(0).Name
 objExcelApp.Sheets(1).Range("b"&Trim(1)) = oRs.Fields(1).Name
 objExcelApp.Sheets(1).Range("c"&Trim(1)) = oRs.Fields(2).Name
 objExcelApp.Sheets(1).Range("d"&Trim(1)) = oRs.Fields(3).Name
 objExcelApp.Sheets(1).Range("e"&Trim(1)) = oRs.Fields(4).Name

 For i=1 To oRs.RecordCount

 
 ''NewDate = DateAdd("h", 8, "FormatNumber(oRs.Fields(1).value, 1)")
 objExcelApp.Sheets(1).Range("a"&Trim(i+1)) =oRs.Fields(0).value
 objExcelApp.Sheets(1).Range("b"&Trim(i+1)) =oRs.Fields(1).value ''NewDate

 objExcelApp.Sheets(1).Range("c"&Trim(i+1)) = FormatNumber(oRs.Fields(2).value, 1)
 objExcelApp.Sheets(1).Range("d"&Trim(i+1)) = FormatNumber(oRs.Fields(3).value, 1)
 objExcelApp.Sheets(1).Range("e"&Trim(i+1)) = FormatNumber(oRs.Fields(4).value, 1)
 oRs.MoveNext
 Next
 oRs.Close
 objexcelapp.activeworkbooks.save
 objexcelapp.workbooks.close
 objexcelapp.quit
 Set objexcelapp=nothing
 Set oRs = Nothing
 conn.Close
 Set conn = Nothing

 我已经测试通过了，稍微修改就可以查询导出到excel中，你要在d盘建一个名为book的excel表格