我的代码在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()
答案 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