QueryTable导出数据无法彻底删除查询表(更新为2003版本)

Henry D. Sy

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

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



(如果保留查询表,每次打开该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里发现,部分连接存在,没有完全删除!

tmtony

我来试试

tmtony

我这里出错

Henry D. Sy

tmtony 发表于 2017-7-6 14:46
我这里出错

我没有提示任何错误呀,导出的数据也正常,只是没有彻底删除查询表

access新新新手

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

我这里也运行不了

Henry D. Sy

access新新新手 发表于 2017-7-6 15:43
我这里也运行不了

难道是版本的问题
我是office 2016

access新新新手

Henry D. Sy 发表于 2017-7-6 20:15
难道是版本的问题
我是office 2016

我一直用的2010

Henry D. Sy

access新新新手 发表于 2017-7-7 07:39
我一直用的2010

更新一下,为2003版本,请帮忙测试!

access新新新手

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

还是不行

Henry D. Sy

access新新新手 发表于 2017-7-7 08:44
还是不行

重新引用一下excel