[分享]数据导出到Excel
时 间:2008-01-13 09:49:43
作 者:cuxun ID:274 城市:肇庆
摘 要:[分享]数据导出到Excel
正 文:
Public Function AccessToExcel(ByVal TempSql As String, Optional TempName As String)
'数据导出到Excel
'tempsql:支持sql语句\查询\表
'tempName:导出Excel的工作表的名称
'注意必须引用excel对象
On Error GoTo Err:
Dim row As Integer
Dim col As Integer
Dim Conn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim sql As String
Dim ExcelApp As Excel.Application
Dim ExcelWst As Worksheet ''excel窗体
Dim RsCount As Integer ''记录数
Set Conn = CurrentProject.Connection '''本地连接
If TempSql = "" Then Exit Function
' sql = TempSql ' "select * from 书本"
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open TempSql, Conn, 1 ' 1 = adOpenKeyset
Set ExcelApp = New Excel.Application
Set ExcelWst = ExcelApp.Workbooks.Add.Worksheets(1)
ExcelWst.Name = TempName
For col = 0 To Rs.Fields.Count - 1
ExcelWst.Cells(1, col + 1) = Rs.Fields(col).Name
Next
row = 2
RsCount = Rs.RecordCount
Rs.MoveFirst
While Not Rs.EOF
For col = 0 To Rs.Fields.Count - 1
ExcelWst.Cells(row, col + 1) = Rs.Fields(col)
''转换日期型字符的表示格式
If Rs.Fields(col).Type = 7 Then
ExcelWst.Cells(row, col + 1).NumberFormatLocal = "yyyy-m-d;@"
End If
Next
row = row + 1
Rs.MoveNext
Wend
Rs.Close
Set Rs = Nothing
Set Conn = Nothing
ExcelApp.Visible = True
Err:
Exit Function
End Function
'数据导出到Excel
'tempsql:支持sql语句\查询\表
'tempName:导出Excel的工作表的名称
'注意必须引用excel对象
On Error GoTo Err:
Dim row As Integer
Dim col As Integer
Dim Conn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim sql As String
Dim ExcelApp As Excel.Application
Dim ExcelWst As Worksheet ''excel窗体
Dim RsCount As Integer ''记录数
Set Conn = CurrentProject.Connection '''本地连接
If TempSql = "" Then Exit Function
' sql = TempSql ' "select * from 书本"
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open TempSql, Conn, 1 ' 1 = adOpenKeyset
Set ExcelApp = New Excel.Application
Set ExcelWst = ExcelApp.Workbooks.Add.Worksheets(1)
ExcelWst.Name = TempName
For col = 0 To Rs.Fields.Count - 1
ExcelWst.Cells(1, col + 1) = Rs.Fields(col).Name
Next
row = 2
RsCount = Rs.RecordCount
Rs.MoveFirst
While Not Rs.EOF
For col = 0 To Rs.Fields.Count - 1
ExcelWst.Cells(row, col + 1) = Rs.Fields(col)
''转换日期型字符的表示格式
If Rs.Fields(col).Type = 7 Then
ExcelWst.Cells(row, col + 1).NumberFormatLocal = "yyyy-m-d;@"
End If
Next
row = row + 1
Rs.MoveNext
Wend
Rs.Close
Set Rs = Nothing
Set Conn = Nothing
ExcelApp.Visible = True
Err:
Exit Function
End Function
Access软件网QQ交流群 (群号:54525238) Access源码网店
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- 【Access选项卡示例】Ac...(09.09)
- 【Access源码示例】按输入...(09.02)
- 【Access日期区间段查询】...(08.29)
- 【Access日期区间段查询】...(08.27)
- Access怎样才能实现日期时...(08.21)
- 【Access定时打开查询】A...(08.19)
- Access生成固定数量的记录...(08.13)
- Access怎样才能实现日期时...(08.12)
- Access利用导航窗体控件对...(08.03)
学习心得
最新文章
- Access表中的字段名、字段标题...(09.19)
- Access快速开发平台--更改“...(09.18)
- 【中秋及国庆优惠】Access培训...(09.15)
- Access如何将日期型的数值转换...(09.14)
- 英文输入法输入数据中存在单引号引起...(09.11)
- 【Access选项卡示例】Acce...(09.09)
- 让Access光标停留在指定的控件...(09.07)
- 关于Access查询条件里使用通配...(09.06)
- Access报表偷懒制作法--Ac...(09.05)
- Access快速开发平台--窗体数...(09.04)