Citect2018R2读取Access数据库数据导出到Excel

本文使用VBA实现Citect2018中从Access数据库读取数据导出生成Excel表格功能，与上一个文档-存储数据到Access数据库-结合使用，实现报表记录及导出功能。

1、打开Cicode编辑器

• 2、新建CitectVBA文件

3、编辑VBA文件

编辑代码，参考文档末尾代码示例。注意数据库连接及表格样式

数据库连接：示例代码采用DSN方式，DSN连接方法在-存储数据到Access数据库-文档中，需要更改DSN连接名

数据库操作：根据需求编写sql语句

代码示例:

Author:dlluo

Time:2021.03.24

'边框boders属性xlBodersIndex有以下成员：

'xlDiagonalDown 数值是5,从区域中每个单元格的左上角到右下角的边框

'xlDiagonalUp  数值是6 ,从区域中每个单元格的左下角到右上角的边框

'xlEdgeBottom 数值是9，区域底部的边框

'xlEdgeLeft 数值是7，区域左边的边框

'xlEdgeRight 数值是10，区域右边的边框

'xlEdgeTop 数值是8，区域顶部的边框

'xlInsideHorizontal 数值是12，区域内部单元格水平边框

'xlInsideVertical 数值是11，区域内部单元格垂直边框

'边框的线型XlLineStyle有以下成员:

'xlContinuous，数值1，实线

'xlDash，数值-4115，虚线

'xlDashDot,数值4,点划相间线

'xlDashDotDot,数值5,双点划相间线

'xlDot,数值-4118,点式线

'xlDouble,数值-4119，双线

'xlLineStyleNone,数值-4142，无线

'xlSlantDashDotxlLineStyle,数值13，倾斜的划线

Sub ddd()

 Dim xlapp As Object

 Dim ws As Object

 Dim filename,filename1 As string

 Dim objcon As Object

 Dim objcom As Object

 Dim objrs  As Object

 Dim xlbook As Object

 Dim xlsheet As Object

 Dim i,n,m As Integer

 Dim strcon As string

 m=5

 n=4

'--------------------------------------------调用函数库------------------------------------------------------------------------------------

 Set objcon = createobject("adodb.connection") ' 调用ADO数据库连接

 Set objrs = createobject("adodb.recordset") '调用ADO record函数库

 Set objcom=createobject("adodb.Command") ' 调用ADO命令函数库

'--------------------------------连接数据库，本代码采用DSN方式连接，也可通过注释行代码连接------------------------------------------------------------

' strcon="Provide=MSDASQL.1;Persist Security Info=False;Data Source=aa" ' 数据库连接参数

' objcon.connectionstring = strcon

' objcon.Cursorlocation=3

 objcon.open "DSN=Citect_DB" '通过DSN连接数据库

'--------------------------------------------------操作数据库--------------------------------------------------------------------------------

 objcom.commandtype = 1 'type=1,按命令或存储过程调用的文本定义计算 CommandText。

 Set objcom.ActiveConnection=objcon '设置当前的 Connection 对象

 objcom.CommandText= "select top 2 * from Table1 order by Time1 desc" 'SQL语句，字符长度超过225，需要新建字符串变量

 Set objrs = objcom.Execute '执行在 CommandText 属性中指定的查询、SQL 语句或存储过程,返回 Recordset 对象引用

'--------------------------------------------表格样式设置------------------------------------------------------------------------------------

 Set xlapp = createobject("Excel.Application")

 xlApp.Visible =false

 Set xlbook = xlapp.workbooks.Add '新建一个工作表。

 xlApp.Worksheets("sheet1").Activate '新工作表将成为活动工作表

 Set xlsheet = xlbook.worksheets(1)

 For i=0 To (objrs.Fields.Count - 1)

     xlApp.Worksheets("sheet1").Cells(3,i + 1) = objrs.Fields(i).Name '写字段名  cell(3,2)表示表格中的第三行第二列，以此类推

 Next

 xlApp.Worksheets("sheet1").cells(1,1)="报表" '直接向表格第一行第一列填充数据

 objrs.movefirst ' 移动到最前面一条记录

 xlsheet.range("a4").CopyFromRecordset objrs

 xlapp.Range("a1:c1").MergeCells = True '合并单元格

 xlapp.Range("A1").ColumnWidth = 15 '日期列宽度15

 xlapp.Range("a1:c1").Interior.ColorIndex = 34 '更改背景颜色

 xlapp.Range("a1:c1").Font.ColorIndex = 45 '更改字体颜色

 xlapp.Range("a1:c1").Font.Name= "微软雅黑" '更改字体样式

  xlapp.Range("a1:c10").Font.Size= 9 '更改字体样式

 xlapp.Range("a1:c10").Borders.LineStyle = 1 '更改边框样式

 xlapp.Range("a1:c1").Borders.ColorIndex = 3 '更改边框颜色

 xlapp.Range("a4:c" & CStr(3 + m)).HorizontalAlignment = 3 '居中

 xlapp.Range("a4:c" & CStr(3 + m)).Select

 xlapp.cells(1,1).HorizontalAlignment = 3

 xlapp.worksheets("sheet1").cells(2,1)="生成时间∶"

 xlapp.worksheets("sheet1").cells(2,2)=Year(Now) & "年" & Month(Now) & "月" & Day(Now) & "日"

'--------------------------------------------数据导入完成，生成Excel文件------------------------------------------------------------------------------------

 While xlapp.Worksheets("sheet1").Cells((3+objrs.recordcount),objrs.Fields.Count)="" '等待导入数据完毕

 

 Wend

    filename = Year(Now) & "年" & Month(Now) & "月" & Day(Now) & "日-" & Hour(Now) & "点" & Minute(Now) & "分" & Second(Now) & "秒生成报表.xlsx" '定义Excel文件名称

    filename1 = "D:\excel报表导出\"

    xlapp.ActiveWorkbook.saveas filename1 &filename '根据路径及文件名生成Excel文件

'--------------------------------------------Excel文件生成完成，关闭连接及进程------------------------------------------------------------------------------------

    Set ws = createobject("wscript.shell")

    ws.run "cmd /c D:\excelkill.bat",0 'kill excel.exe 结束Excel进程

    Set ws = Nothing

    xlapp.quit

    Set xlapp = Nothing

    msgbox "成功导出到D:\"

   

End Sub

4、定义事件

周期触发或时间触发，Cicode函数及VBA函数调用方法不同

AddReordToAccessDB()为Cicode函数，存储数据到Access数据库

ddd为VBA函数，导出Access数据库数据生成Excel文件