VBs读取SQLserver数据库，并写值到excel中

最新推荐文章于 2024-09-22 07:00:00 发布

weixin_30918633

最新推荐文章于 2024-09-22 07:00:00 发布

阅读量872

点赞数 1

文章标签：数据库

原文链接：http://www.cnblogs.com/Vziiii/p/6566154.html

版权

 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