1 Dim t 2 '获取系统当前时间 3 t=Year(Now)&"."&Month(Now)&"."&Day(Now)&"-"&Hour(Now)&"."&Minute(Now)&"."&Second(Now) 4 Dim filename,sheetname ,xlApp, xlWorkbook, xlWorksheet 5 Dim i,constr,con,rst,iRowCount,sql 6 7 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 8 Set con = CreateObject("ADODB.Connection") 9 con.ConnectionString = constr 10 con.Open 11 12 13 If Con.State = 0 Then '判断数据库连接是否成功 14 ' MsgBox "连接数据库失败" 15 Else 16 MsgBox "连接数据库成功" 17 End If 18 '打开excel表 19 Set xlApp=CreateObject("Excel.Application") 20 Set xlWorkBook=xlApp.Workbooks.Add 21 xlApp.Visible=True 22 xlApp.Sheets.Item(1).Name="ERS点" '设置第一个sheet名字 23 Set xlWorksheet=xlApp.Sheets.Item(1) 24 '写入列名字 25 xlWorksheet.Range("B1").Value ="X" 26 xlWorksheet.Range("C1").Value="Y" 27 xlWorksheet.Range("D1").Value="Z" 28 'xlWorksheet.Range("A1").Value="ID" 29 xlWorksheet.Range("A1").Value="点名" 30 xlWorksheet.Range("E1").Value="X1" 31 xlWorksheet.Range("F1").Value="Y1" 32 xlWorksheet.Range("G1").Value="Z1" 33 34 '查询 35 Set rst= CreateObject("ADODB.Recordset") 36 sql="select * from initial_coordinates" 37 rst.open sql,con,1,3,1 38 iRowCount = rst.recordcount ‘统计查询到的的数据量 39 'Msgbox iRowCount 40 '写值到excel 41 For i=2 To iRowCount+1 42 xlWorksheet.Range("A" & i).Value= rst(1) 43 xlWorksheet.Range("B" & i).Value= rst(2) 44 xlWorksheet.Range("C" & i).Value= rst(3) 45 xlWorksheet.Range("D" & i).Value= rst(4) 46 xlWorksheet.Range("E" & i).Value= rst(5) 47 xlWorksheet.Range("F" & i).Value= rst(6) 48 xlWorksheet.Range("G" & i).Value= rst(7) 49 50 rst.movenext 51 Next 52 xlApp.ActiveWorkbook.SaveAs("d:ERS点数据"+ t +".xls") 53 MsgBox "导出数据成功！" 54 If con.state Then con.Close '关闭数据连接 55 Set xlWorkBook=Nothing 56 Set xlApp=Nothing