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
