Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > 源码示例

【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源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助