【Access源码示例】-导入导出系列-根据SQL语句导出数据到txt记事本
时 间:2012-08-20 09:24:07
作 者:金宇 ID:43 城市:江阴
摘 要:可以自己指定sql语句导出,并且可以指定导出的分隔符号“,”、“|”、“;”、空格、制表符等
正 文:
'=====================================================
'函数名称: SQLExportToTxt
'功能描述: 根据SQL语句导出数据到记事本
'输入参数: strSQL 必选的。select选择性SQL语句
' FileName 可选。导出的记事本文件名
' Separator 可选。分隔符,可以是“,”、“|”、“;”、空格、制表符
'返回参数: 无
'使用示例: SQLExportToTxt "select * from 表名称/查询名称","导出数据.txt",","
'作 者: 金宇
'创建日期: 2012-8-19
'=====================================================
Public Function SQLExportToTxt(ByVal strSQL As String, ByVal FileName As String, ByVal Separator As Variant)
On Error GoTo Err_ExportToTxt
Dim intI As Integer
Dim intMsgResult As VbMsgBoxResult
Dim rstCount As Long
Dim rst As Adodb.Recordset
Dim FileNumber As Integer
Dim sText As String
Dim I As Long
rstCount = CurrentProject.Connection.Execute("select count(*) from (" & strSQL & ") as temp_A")(0).Value '取总的记录数
If rstCount = 0 Then
MsgBox ("没有数据可导出!"), vbExclamation, "提示"
Exit Function
End If
If Trim$(FileName) = "" Then FileName = "导出的数据.txt"
If Not FileName Like "*.txt" Then
FileName = FileName & ".txt"
End If
If Not (FileName Like "[A-z]:\*" or FileName Like "\\*") Then
With Application.FileDialog(2)
.InitialFileName = FileName
.AllowMultiSelect = False
If .Show Then
FileName = .SelectedItems(1)
Else
Exit Function
End If
End With
End If
'如果txt文件已存在,则先删除
If Dir(FileName) <> "" Then Kill FileName
Set rst = New Adodb.Recordset
rst.Open strSQL, CurrentProject.Connection, 1, 1
FileNumber = FreeFile ' Get unused file number
Open FileName For Append As #FileNumber ' Connect to the file
Do While Not rst.EOF
sText = ""
For intI = 0 To rst.Fields.Count - 1
sText = sText & rst.Fields(intI) & Separator
Next
sText = Left(sText, Len(sText) - 1)
Print #FileNumber, sText ' Append our string
rst.MoveNext
Loop
rst.Close
Close #FileNumber ' Close the file
intMsgResult = MsgBox("数据已导出,是否打开并查看?", vbQuestion + vbYesNo)
If intMsgResult = vbYes Then ShellEx (FileName) '打开文件
Exit_ExportToTxt:
On Error Resume Next
DoCmd.Hourglass False
Exit Function
Err_ExportToTxt:
If Err = 70 Then
MsgBox "无法删除文件 '" & FileName & "',可能该文件已被打开或没有权限。", vbCritical
Else
MsgBox Err.Source & " #" & Err & vbCrLf & vbCrLf & Err.Description, vbCritical
End If
Resume Exit_ExportToTxt
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)