使用VB写入Excel(多行)

时间:2017-08-07 14:11:09

标签: excel vb.net excel-vba vba

我的代码在SQL中通过查询成功创建了Excel文件,尽管创建它需要花费太多时间。如何最大限度地缩短创建它的时间?
代码如下:

rsAnaforaPr.DoQuery("SELECT * FROM [dbo].[zam_excel]")
rsAnaforaPr.MoveFirst()
   hj = False
   rowCount = 1
   While rsAnaforaPr.EoF = False
        shell1 = rsAnaforaPr.Fields.Item("Value1").Value
        If hj = False Then
            oExcel = CreateObject("Excel.Application")
            oExcel.DisplayAlerts = False
            oBook = oExcel.Workbooks.Add
            hj = True
            oBook.SaveAs("C:\Desktop\New folder\excel.xlsx")
            oBook.Close(True)
            oExcel.Quit()
            oExcel = CreateObject("Excel.Application")
            oExcel.DisplayAlerts = False
            oBook = oExcel.Workbooks.Open("C:\Desktop\New folder\excel.xlsx")        
            oSheet = oBook.Worksheets("Sheet1")
            oSheet.Range("A" & rowCount).Value = "Value1"
            rowCount = rowCount + 1
            oSheet.Range("A" & rowCount).NumberFormat = "@"
            oSheet.Range("A" & rowCount).Value = shell1 
       Else
            oSheet.Range("A" & rowCount).NumberFormat = "@"
            oSheet.Range("A" & rowCount).Value = shell1                     
        End If
        rowCount = rowCount + 1
        rsAnaforaPr.MoveNext()
    End While
    oBook.Close(True)
    oExcel.Quit()

2 个答案:

答案 0 :(得分:0)

在开头写下以下内容:

Application.ScreenUpdating = False

然后在代码结束时写:

Application.ScreenUpdating = True

速度升级将是可见的&显。 在此处详细了解ScreenUpdating属性 - https://msdn.microsoft.com/en-us/vba/excel-vba/articles/application-screenupdating-property-excel

答案 1 :(得分:0)

我使用类似下面的代码。
但是,说,我刚刚注意到你的VB.NET标签......出于某种原因将其读作Access 我想这对那不起作用?有人让我知道&我会删除答案。

Sub Test()
    Dim oXL As Object
    Dim oWrkBk As Object
    Dim DB As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim prm As DAO.Parameter
    Dim rst As DAO.Recordset

    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Defer error trapping in case Excel is not running. '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    Set oXL = GetObject(, "Excel.Application")

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'If an error occurs then create an instance of Excel. '
    'Reinstate error handling.                            '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Err.Number <> 0 Then
        On Error GoTo -1
        On Error GoTo ERR_HANDLE
        Set oXL = CreateObject("Excel.Application")
    End If

    Set oWrkBk = oXL.workbooks.Add

    oXL.Visible = True

    Set DB = CurrentDb
    Set qdf = DB.CreateQueryDef("", "SELECT * FROM [dbo].[zam_excel]")
    For Each prm In qdf.Parameters
        prm.Value = Eval(prm.Name)
    Next prm
    Set rst = qdf.OpenRecordset

    If Not (rst.BOF And rst.EOF) Then
        oWrkBk.worksheets(1).range("A1").CopyFromRecordSet rst
    End If

EXIT_PROC:

        On Error GoTo 0
        Exit Sub

ERR_HANDLE:
        Select Case Err.Number

            Case Else
                MsgBox Err.Description & "( " & Err.Number & ")", vbOKOnly
                Resume EXIT_PROC
        End Select

End Sub