【求解】新定义一个application通过ADO对象获取数据失败

suye1010

以下的代码可以正确的运行并获得结果：

1. Sub UpdateXlsFileForUpload()
   
2. Dim cnn, SQL As String, myData As String, wb As Workbook
   
3. myData = ThisWorkbook.Path & "\Off Take Tire Information.mdb"
   
4. Set cnn = CreateObject("ADODB.Connection")
   
5. cnn.Open "provider=microsoft.ace.oledb.12.0;data source=" & myData
   
6. Set wb = Application.Workbooks.Open(ThisWorkbook.Path & "\Reports\Off Take Tire information-Notes Database.xls")
   
7. With wb
   
8.     SQL = "SELECT * FROM [Technical Information-Summary] Where [Supplier]  is not null Order By [supplier],[Tread Pattern],[True Brand],[Status],[Size]"
   
9.     If Not .Sheets("Technical Information").ListObjects("TechnicalInformation").DataBodyRange Is Nothing Then .Sheets("Technical Information").ListObjects("TechnicalInformation").DataBodyRange.Delete
   
10.     .Sheets("Technical Information").Cells(4, 1).Offset(1, 0).CopyFromRecordset cnn.Execute(SQL)
    
11.     If Not .Sheets("Update History").ListObjects("UpdateHistory").DataBodyRange Is Nothing Then .Sheets("Update History").ListObjects("UpdateHistory").DataBodyRange.Delete
    
12.     .Sheets("Update History").Cells(2, 1).CopyFromRecordset cnn.Execute("SELECT * FROM [Technical Information-Update History]")
    
13.     .Close SaveChanges:=False
    
14. End With
    
15. cnn.Close
    
16. Set cnn = Nothing
    
17. End Sub
    

复制代码

但当使用以下代码，在运行到第10行，显示数据更新了，但是excel被莫名关闭，后续代码无法执行，再次打开要输入的文件也会发现未被保存

1. Sub UpdateXlsFileForUpload()
   
2. Dim cnn, SQL As String, myData As String, wb As Workbook, app as New Application
   
3. myData = ThisWorkbook.Path & "\Off Take Tire Information.mdb"
   
4. Set cnn = CreateObject("ADODB.Connection")
   
5. cnn.Open "provider=microsoft.ace.oledb.12.0;data source=" & myData
   
6. Set wb = app.Workbooks.Open(ThisWorkbook.Path & "\Reports\Off Take Tire information-Notes Database.xls")
   
7. With wb
   
8. SQL = "SELECT * FROM [Technical Information-Summary] Where [Supplier] is not null Order By [supplier],[Tread Pattern],[True Brand],[Status],[Size]"
   
9. If Not .Sheets("Technical Information").ListObjects("TechnicalInformation").DataBodyRange Is Nothing Then .Sheets("Technical Information").ListObjects("TechnicalInformation").DataBodyRange.Delete
   
10. .Sheets("Technical Information").Cells(4, 1).Offset(1, 0).CopyFromRecordset cnn.Execute(SQL)
    
11. If Not .Sheets("Update History").ListObjects("UpdateHistory").DataBodyRange Is Nothing Then .Sheets("Update History").ListObjects("UpdateHistory").DataBodyRange.Delete
    
12. .Sheets("Update History").Cells(2, 1).CopyFromRecordset cnn.Execute("SELECT * FROM [Technical Information-Update History]")
    
13. .Close SaveChanges:=False
    
14. End With
    
15. cnn.Close
    
16. Set cnn = Nothing
    
17. End Sub

复制代码