VB操作Excel,为什么只能操作一次,第二次就出错(完成后,再追加分!)
我做一个程序:用VB从数据库中查询数据。先创建一个新的Excel文件,然后用.CopyFromRecordsetcn.Execute(sq1)的方法直接粘贴到新创建的Ex...
我做一个程序:用VB从数据库中查询数据。先创建一个新的Excel文件,然后用 .CopyFromRecordset cn.Execute(sq1)的方法直接粘贴到新创建的Excel文件中,然后关闭。但是这种方法只能同时执行一次,如何第二次查询后再次创建Excel文件是可以的,只是不能粘贴到数据了。经查找资料,好像是任务管理器中的Excel.exe进程没有别关掉,才导致错误。请大家帮帮忙吧。谢谢了!
以下是代码!高手给看看吧。急啊!!!!
Dim cn As New ADODB.Connection
Dim rs1 As New ADODB.Recordset
Dim sq1 As String
Dim xlApp As Excel.Application
Dim xlBook As Excel.workbook
Dim xlSheet As Excel.Worksheet
Sub 导出Excel数据()
On Error GoTo err
cn.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & App.Path & "\Data.mdb"
sq1 = saveSQL 'saveSQL 保存sql语句的全局变量
rs1.Open sq1, cn, adOpenKeyset, adLockOptimistic
Dim GetFileName As Variant
Form8.CommonDialog1.Filter = "Excel文件(*.xls)|*.xls|所有文件(*.*)|*.*"
Form8.CommonDialog1.CancelError = True
Form8.CommonDialog1.ShowSave
GetFileName = Form8.CommonDialog1.FileName
If Trim(GetFileName) = "" Then Exit Sub
Set xlApp = CreateObject("Excel.Application") '创建Excel文件
Set xlApp = New Excel.Application
xlApp.SheetsInNewWorkbook = 1 '将新建的工作薄数量设为1
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1) '第1张工作表
xlApp.ActiveWorkbook.SaveAs GetFileName '保存Excel文件
xlSheet.Cells(2, 1) = "店铺名称"
xlSheet.Cells(2, 2) = "发货日期"
xlSheet.Cells(2, 3) = "产品编号"
xlSheet.Cells(2, 4) = "类 别"
xlSheet.Cells(2, 5) = "颜 色"
xlSheet.Cells(2, 6) = "号 型"
xlSheet.Cells(2, 7) = "发货数量"
xlSheet.Cells(2, 8) = "发货单号"
xlSheet.Cells(2, 9) = "备 注"
xlSheet.Cells(3, 1).CopyFromRecordset cn.Execute(sq1) '粘贴数据
xlApp.ActiveWorkbook.Close True
xlApp.Quit
Set xlApp = Nothing
MsgBox "数据导出成功", vbInformation, "导出数据"
rs1.Close
cn.Close
Set rs1 = Nothing
Set cn = Nothing
Exit Sub
err:
xlApp.Quit
MsgBox "数据出错", vbInformation, "导出数据"
rs1.Close
cn.Close
Set rs1 = Nothing
Set cn = Nothing
Exit Sub
End Sub
一楼的回答几乎是废话。三楼的好歹是个代码,分就给三楼吧。这个问题我自己搞定了。谢谢几位的回答 。 展开
以下是代码!高手给看看吧。急啊!!!!
Dim cn As New ADODB.Connection
Dim rs1 As New ADODB.Recordset
Dim sq1 As String
Dim xlApp As Excel.Application
Dim xlBook As Excel.workbook
Dim xlSheet As Excel.Worksheet
Sub 导出Excel数据()
On Error GoTo err
cn.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & App.Path & "\Data.mdb"
sq1 = saveSQL 'saveSQL 保存sql语句的全局变量
rs1.Open sq1, cn, adOpenKeyset, adLockOptimistic
Dim GetFileName As Variant
Form8.CommonDialog1.Filter = "Excel文件(*.xls)|*.xls|所有文件(*.*)|*.*"
Form8.CommonDialog1.CancelError = True
Form8.CommonDialog1.ShowSave
GetFileName = Form8.CommonDialog1.FileName
If Trim(GetFileName) = "" Then Exit Sub
Set xlApp = CreateObject("Excel.Application") '创建Excel文件
Set xlApp = New Excel.Application
xlApp.SheetsInNewWorkbook = 1 '将新建的工作薄数量设为1
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1) '第1张工作表
xlApp.ActiveWorkbook.SaveAs GetFileName '保存Excel文件
xlSheet.Cells(2, 1) = "店铺名称"
xlSheet.Cells(2, 2) = "发货日期"
xlSheet.Cells(2, 3) = "产品编号"
xlSheet.Cells(2, 4) = "类 别"
xlSheet.Cells(2, 5) = "颜 色"
xlSheet.Cells(2, 6) = "号 型"
xlSheet.Cells(2, 7) = "发货数量"
xlSheet.Cells(2, 8) = "发货单号"
xlSheet.Cells(2, 9) = "备 注"
xlSheet.Cells(3, 1).CopyFromRecordset cn.Execute(sq1) '粘贴数据
xlApp.ActiveWorkbook.Close True
xlApp.Quit
Set xlApp = Nothing
MsgBox "数据导出成功", vbInformation, "导出数据"
rs1.Close
cn.Close
Set rs1 = Nothing
Set cn = Nothing
Exit Sub
err:
xlApp.Quit
MsgBox "数据出错", vbInformation, "导出数据"
rs1.Close
cn.Close
Set rs1 = Nothing
Set cn = Nothing
Exit Sub
End Sub
一楼的回答几乎是废话。三楼的好歹是个代码,分就给三楼吧。这个问题我自己搞定了。谢谢几位的回答 。 展开
展开全部
没有看你的代码 ,但是你说:经查找资料,好像是任务管理器中的Excel.exe进程没有别关掉,才导致错误。
那么你就把进程关掉就行了啊。
ctrl+alt+del
选择“进程”,右边第二个
找到你的excel.exe进程,然后结束就行了。
如果真的是这个原因的话。
那么你就把进程关掉就行了啊。
ctrl+alt+del
选择“进程”,右边第二个
找到你的excel.exe进程,然后结束就行了。
如果真的是这个原因的话。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
xlbook.Close '关闭工作薄文件
xlapp.Quit '结束excel对象
Set xlapp = Nothing '释放xlapp对象得内存空间
Set xlbook = Nothing
Set xlsheet = Nothing
xlapp.Quit '结束excel对象
Set xlapp = Nothing '释放xlapp对象得内存空间
Set xlbook = Nothing
Set xlsheet = Nothing
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
excel保存这段没有问题,感觉CommonDialog1.ShowSave 这个应该设置成可以覆盖保存
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询