另外查看任务管理器EXCEL cup 占用 >=50%
vb cup 占用 16-20%下面是我的代码Dim FileName As String
Dim FolderName As String
Dim Excel_File As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Sql = GetSqlString
Set partsRs = Con.Execute(Sql)
If partsRs.RecordCount > 0 Then
Set Excel_File = CreateObject("Excel.Application")
Set Excel_WorkBook = Excel_File.Workbooks.Add
Set Excel_Sheet = Excel_WorkBook.Worksheets(1)
partsRs.MoveFirst Excel_Sheet.Cells(1, 1) = "1"
Excel_Sheet.Cells(1, 2) = "2"
Excel_Sheet.Cells(1, 3) = "3"
Excel_Sheet.Cells(1, 4) = "4"
Excel_Sheet.Cells(1, 1) = "5"
Excel_Sheet.Cells(1, 2) = "6"
Excel_Sheet.Cells(1, 3) = "7"
Excel_Sheet.Cells(1, 4) = "8"
Excel_Sheet.Cells(1, 1) = "9"
Excel_Sheet.Cells(1, 2) = "10"
Excel_Sheet.Range("A1:J1").HorizontalAlignment = xlCenter For irow = 1 To partsRs.RecordCount
Excel_Sheet.Cells(irow + 1, 1).Value = partsRs(0)
Excel_Sheet.Cells(irow + 1, 2).Value = partsRs(1)
Excel_Sheet.Cells(irow + 1, 3).Value = partsRs(2)
Excel_Sheet.Cells(irow + 1, 4).Value = partsRs(3)
Excel_Sheet.Cells(irow + 1, 1).Value = partsRs(4)
Excel_Sheet.Cells(irow + 1, 2).Value = partsRs(5)
Excel_Sheet.Cells(irow + 1, 3).Value = partsRs(6)
Excel_Sheet.Cells(irow + 1, 4).Value = partsRs(7)
Excel_Sheet.Cells(irow + 1, 1).Value = partsRs(8)
Excel_Sheet.Cells(irow + 1, 2).Value = partsRs(9)
Excel_Sheet.Range(Excel_Sheet.Cells(1 + irow, 1), Excel_Sheet.Cells(1 + irow, 10)).HorizontalAlignment = xlCenter
partsRs.MoveNext
Next irow
Excel_File.ActiveWorkbook.SaveAs & "c:\test.xls"
Excel_File.ActiveWorkbook.Save
MsgBox "导出成功!"
Excel_File.DisplayAlerts = False
Excel_WorkBook.Close
Excel_File.Quit
Set Excel_Sheet = Nothing
Set Excel_WorkBook = Nothing
Set Excel_File = Nothing
vb cup 占用 16-20%下面是我的代码Dim FileName As String
Dim FolderName As String
Dim Excel_File As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Sql = GetSqlString
Set partsRs = Con.Execute(Sql)
If partsRs.RecordCount > 0 Then
Set Excel_File = CreateObject("Excel.Application")
Set Excel_WorkBook = Excel_File.Workbooks.Add
Set Excel_Sheet = Excel_WorkBook.Worksheets(1)
partsRs.MoveFirst Excel_Sheet.Cells(1, 1) = "1"
Excel_Sheet.Cells(1, 2) = "2"
Excel_Sheet.Cells(1, 3) = "3"
Excel_Sheet.Cells(1, 4) = "4"
Excel_Sheet.Cells(1, 1) = "5"
Excel_Sheet.Cells(1, 2) = "6"
Excel_Sheet.Cells(1, 3) = "7"
Excel_Sheet.Cells(1, 4) = "8"
Excel_Sheet.Cells(1, 1) = "9"
Excel_Sheet.Cells(1, 2) = "10"
Excel_Sheet.Range("A1:J1").HorizontalAlignment = xlCenter For irow = 1 To partsRs.RecordCount
Excel_Sheet.Cells(irow + 1, 1).Value = partsRs(0)
Excel_Sheet.Cells(irow + 1, 2).Value = partsRs(1)
Excel_Sheet.Cells(irow + 1, 3).Value = partsRs(2)
Excel_Sheet.Cells(irow + 1, 4).Value = partsRs(3)
Excel_Sheet.Cells(irow + 1, 1).Value = partsRs(4)
Excel_Sheet.Cells(irow + 1, 2).Value = partsRs(5)
Excel_Sheet.Cells(irow + 1, 3).Value = partsRs(6)
Excel_Sheet.Cells(irow + 1, 4).Value = partsRs(7)
Excel_Sheet.Cells(irow + 1, 1).Value = partsRs(8)
Excel_Sheet.Cells(irow + 1, 2).Value = partsRs(9)
Excel_Sheet.Range(Excel_Sheet.Cells(1 + irow, 1), Excel_Sheet.Cells(1 + irow, 10)).HorizontalAlignment = xlCenter
partsRs.MoveNext
Next irow
Excel_File.ActiveWorkbook.SaveAs & "c:\test.xls"
Excel_File.ActiveWorkbook.Save
MsgBox "导出成功!"
Excel_File.DisplayAlerts = False
Excel_WorkBook.Close
Excel_File.Quit
Set Excel_Sheet = Nothing
Set Excel_WorkBook = Nothing
Set Excel_File = Nothing
解决方案 »
- 如何用vb中斷指定ip和本機的所有連接
- 急求一排序函数!
- 实时错误 “3011”:Microsoft Jet数据库引擎找不到对象
- 我在win2003用VB6做托盘程序,可总提示“找不到DLL入口点 shell_notifyiconA in shell32.dll”,这是怎么回事?
- 用VB实现层级查询的菜鸟问题
- 类、类模块、用户控件的用区别???
- 我想让别人只能添加记录,不能修改记录,怎么可以做到啊?
- 张榜:打包问题,寻求良医。悬壶济世的人,到哪去了???
- 请教小草等高手一个关于打印的问题!!!!!!!!!!
- 刚学vb才2天的问题
- 请教,如何将一个窗体放在桌面之上,但又不会 遮住其它窗口
- 如何得到其他程序文本框中内容
口EXEC master..xp_cmdshell 'bcp 数据库名.dbo.表名 out c:\table1.xls -c -q -S 实例名 -U 用户名 -P 令
变通一下嘛,在数据库中创建一个视图,然后再:EXEC master..xp_cmdshell 'bcp 数据库名.dbo.视图名 out c:\table1.xls -c -q -S 实例名 -U 用户名 -P