VB中导出，自动生成Excel

最新推荐文章于 2024-02-26 17:08:30 发布

秋水森

最新推荐文章于 2024-02-26 17:08:30 发布

阅读量2k

点赞数

分类专栏：编程应用

本文链接：https://blog.csdn.net/qiushuisen/article/details/39804329

版权

编程应用专栏收录该内容

9 篇文章 0 订阅

订阅专栏

Excel导出是企业中比较常见的应用，看到大家都有一些写法，在这儿，我给出一个可以生成Excel的过程，希望可以帮助有需要的朋友

在使前之前，需要引用ADO和Microsft Excel Object相应的版本；

Public Sub QtX(Sql As String)
    On Error GoTo e:
    Dim Rs As New ADODB.Recordset
    Dim SQL As String
    Dim SQL1 As String
    Dim Rs2 As New ADODB.Recordset
    Dim I As Integer
    Dim j As Long
    Dim XlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Set XlApp = CreateObject("Excel.Application")
    Set xlBook = XlApp.Workbooks.Add
    Dim xlSheet As New Excel.Worksheet
    Set xlSheet = xlBook.Worksheets(1)
'--------------------------------------------------------------------------------
    cOn '连接数据库的一个过程，需要根据实际进行设置
'--------------------------------------------------------------------------------
    Set Rs = New ADODB.Recordset
    Rs.CursorLocation = adUseClient
    Rs.Open SQL, cN, adOpenDynamic, adLockPessimistic
'----------------------------------------------------------------------
    Dim Qt1 As QueryTable
    Set Qt1 = xlSheet.QueryTables.Add(Connection:=Rs, Destination:=xlSheet.Cells(j + 2, I + 1))
    With Qt1
                .RefreshStyle = xlInsertEntireRows
                .Refresh
    End With
        Qt1.Delete
    xlSheet.Name = Date
    xlBook.SaveAs App.Path & "\" & 文件名 & ".xlsx"
    xlBook.Close
    XlApp.QuitSet
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set XlApp = Nothing
e: End Sub