Office中国论坛/Access中国论坛

标题: QueryTable导出数据无法彻底删除查询表(更新为2003版本) [打印本页]
作者: Henry D. Sy    时间: 2017-7-6 14:32
标题: QueryTable导出数据无法彻底删除查询表(更新为2003版本)
本帖最后由 Henry D. Sy 于 2017-7-8 09:35 编辑

利用Excel QueryTable导出数据无法彻底删除查询表
有时可以删除,有时又不能删除

特意把导入分成两种情况
最开始时,只写了第一种导出方式,结果没有删除成功
增加了第二种导入方式,发现第一种方式下,删除成功,而第二种却不成功
把两种情况分开写(也就是不在一个模块种),结果是有时成功,有时不成功,
不知道问题出在哪里,搞了半天也没搞明白.
[attach]61660[/attach]


(如果保留查询表,每次打开该Excel文件,总会提醒更新或者启用,除非选项里设为接受所有的连接)
代码如下,请大家指教指教

  1. Private Sub Command0_Click()
  2.     Dim xlApp As New Excel.Application
  3.     Dim xlBook As New Excel.Workbook
  4.     Dim xlSheet As Excel.Worksheet
  5.     Dim xlQuery As Excel.QueryTable
  6.     Dim i As Long
  7.     Dim intRows As Long
  8.     Dim rs As New ADODB.Recordset
  9.     Dim rst As New ADODB.Recordset
  10.     Dim sSQL As String
  11.     xlApp.DisplayAlerts = False
  12.     Set xlBook = xlApp.Workbooks.Open(CurrentProject.Path & "\test.xls")
  13.     xlBook.SaveAs (CurrentProject.Path & "" & Format(Now, "yyyymmddnn") & ".xls")
  14.     rs.CursorLocation = adUseClient
  15.     rst.CursorLocation = adUseClient
  16.     '------------------------------------
  17.     '分成两种情况进行测试删除查询表的结果
  18.     '------------------------------------
  19.     '---------------------------------
  20.     '1.直接将记录导入到Excel工作表A中
  21.     '---------------------------------
  22.     Set xlSheet = xlBook.Worksheets("A")
  23.     rs.Open "A", CurrentProject.Connection, adOpenKeyset, adLockReadOnly
  24.     Set xlQuery = xlSheet.QueryTables.Add(rs, xlSheet.Range("A1"))
  25.     xlQuery.Refresh
  26.     xlQuery.Delete '结果删除成功
  27.     Set xlQuery = Nothing
  28.     rs.Close
  29.     '------------------------------------
  30.     '2.特意采用循环导入工作表B,并分成小表
  31.     '------------------------------------
  32.     intRows = 1
  33.     Set xlSheet = xlBook.Worksheets("B")
  34.     sSQL = "SELECT DISTINCT PO FROM A ORDER BY PO"
  35.     rs.Open sSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
  36.     Do While Not rs.EOF
  37.         sSQL = "SELECT * FROM A WHERE PO='" & rs.Fields("PO") & "'"
  38.         rst.Open sSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
  39.         i = rst.RecordCount
  40.         Set xlQuery = xlSheet.QueryTables.Add(rst, xlSheet.Range("A" & intRows))
  41.         xlQuery.Refresh
  42.         xlQuery.Delete  '结果没有删除了查询表
  43.         Set xlQuery = Nothing
  44.         intRows = intRows + i + 3
  45.         rst.Close
  46.         rs.MoveNext
  47.     Loop
  48.     rs.Close
  49.     xlBook.Save
  50.     xlApp.DisplayAlerts = True
  51.     Set rst = Nothing
  52.     Set rs = Nothing
  53.     xlApp.Visible = True
  54.     Set xlSheet = Nothing
  55.     Set xlBook = Nothing
  56.     Set xlApp = Nothing
  57. End Sub
复制代码


    结果在Excel里发现,部分连接存在,没有完全删除!
[attach]61655[/attach]



作者: tmtony    时间: 2017-7-6 14:41
我来试试
作者: tmtony    时间: 2017-7-6 14:46
我这里出错[attach]61657[/attach]
作者: Henry D. Sy    时间: 2017-7-6 15:30
tmtony 发表于 2017-7-6 14:46
我这里出错

我没有提示任何错误呀,导出的数据也正常,只是没有彻底删除查询表
作者: access新新新手    时间: 2017-7-6 15:43
Henry D. Sy 发表于 2017-7-6 15:30
我没有提示任何错误呀,导出的数据也正常,只是没有彻底删除查询表

我这里也运行不了
作者: Henry D. Sy    时间: 2017-7-6 20:15
access新新新手 发表于 2017-7-6 15:43
我这里也运行不了

难道是版本的问题
我是office 2016
作者: access新新新手    时间: 2017-7-7 07:39
Henry D. Sy 发表于 2017-7-6 20:15
难道是版本的问题
我是office 2016

我一直用的2010
作者: Henry D. Sy    时间: 2017-7-7 08:23
access新新新手 发表于 2017-7-7 07:39
我一直用的2010

更新一下,为2003版本,请帮忙测试!
作者: access新新新手    时间: 2017-7-7 08:44
Henry D. Sy 发表于 2017-7-7 08:23
更新一下,为2003版本,请帮忙测试!

还是不行
[attach]61661[/attach]

[attach]61662[/attach]

[attach]61663[/attach]
作者: Henry D. Sy    时间: 2017-7-7 10:11
access新新新手 发表于 2017-7-7 08:44
还是不行

重新引用一下excel
作者: access新新新手    时间: 2017-7-7 11:27
Henry D. Sy 发表于 2017-7-7 10:11
重新引用一下excel

引用我是重新引用了的还是不行的
作者: Henry D. Sy    时间: 2017-7-11 09:05
本帖最后由 Henry D. Sy 于 2017-7-11 09:08 编辑
tmtony 发表于 2017-7-6 14:41
我来试试

终于找到原因了
每个工作表必须激活
也就是增加一句
xlSheet.Activate
然后再删除xlQuery

奇怪的是,不激活,有时也能删除!!!




欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3