VBA保持excel文件在代码后自锁

我一直在遇到这个代码的问题。 如果我重新启动计算机并运行它，它的工作正常，但一旦代码已经运行一旦开始导致错误。 我将得到“保存错误”或“pipe理员错误”，因为文件（原始或其他）是不可访问的。 我有时可以closures从任务pipe理器的后台excel程序来解决它（但不是总是）

该代码的目的是从互联网上下载一个Excel工作表，并将新行（并更新旧行）添加到ms访问数据库。

最奇怪的是我还没有看到任何有逻辑错误的趋势。

Const localSaveLocation = ######## Const NetworkDSRTLocation = ######## Private Sub download_btn_Click() Dim xlsApp As Excel.Application Dim xlsBook As Excel.Workbook Dim xlsSheet As Excel.Worksheet On Error GoTo adminError Set xlsBook = Workbooks.Open(NetworkDSRTLocation) Set xlsApp = xlsBook.Parent On Error GoTo 0 ' go to the ERS tab of the workbook, delete the first 3 rows Worksheets("ERS").Select Set xlsSheet = xlsBook.Worksheets("ERS") For row_ctr = 1 To 3 xlsSheet.Rows(1).EntireRow.Delete Next row_ctr 'set up 'ERS' named range for all cells in this worksheet xlsSheet.UsedRange.Select col_count = Cells(1, Columns.Count).end(xlToLeft).Column row_count = (xlsSheet.Cells(Rows.Count, 1).end(xlUp).Row) + 1 ActiveWorkbook.Names.Add name:="ERS", RefersToR1C1:="=ERS!R1C1:R" & row_count & "C" & col_count On Error GoTo saveError Kill localSaveLocation xlsBook.SaveAs FileName:=localSaveLocation xlsApp.Quit On Error GoTo 0 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "DSRT_TEMP", localSaveLocation, True, "ERS" numOfChangesDSRT = DCount("ID", "changed_records") DoCmd.RunSQL "update ers_local inner join changed_records on changed_records.id = ers_local.id Set last_updated = Date();" DoCmd.RunSQL "update ers_local inner join dsrt_temp on dsrt_temp.id = ers_local.id Set source = 'DSRT';" DoCmd.RunSQL "DELETE FROM [dsrt_ers] WHERE dsrt_ers.id in (select id from ers_local where source = 'DSRT');" DoCmd.RunSQL "INSERT INTO DSRT_ERS SELECT * FROM DSRT_TEMP" DoCmd.RunSQL "DROP TABLE DSRT_TEMP;" xlsApp.Quit DoCmd.Requery DoCmd.Hourglass False Exit Sub adminError: DoCmd.Hourglass False Exit Sub saveError: DoCmd.Hourglass False On Error Resume Next xlsApp.Quit Exit Sub End Sub 

Answer 1

要非常小心地正确打开和closuresExcel对象：

 Const localSaveLocation = ######## Const NetworkDSRTLocation = ######## Private Sub download_btn_Click() Dim xlsApp As Excel.Application Dim xlsBook As Excel.Workbook Dim xlsSheet As Excel.Worksheet Set xlsApp = New Excel.Application Set xlsBook = xlsApp.Workbooks.Open(NetworkDSRTLocation) ' Go to the ERS tab of the workbook, delete the first 3 rows. Set xlsSheet = xlsBook.Worksheets("ERS") For row_ctr = 1 To 3 xlsSheet.Rows(1).EntireRow.Delete Next row_ctr ' Set up 'ERS' named range for all cells in this worksheet. xlsSheet.UsedRange.Select col_count = xlsSheet.Cells(1, Columns.Count).end(xlToLeft).Column row_count = (xlsSheet.Cells(Rows.Count, 1).end(xlUp).Row) + 1 xlsBook.Names.Add name:="ERS", RefersToR1C1:="=ERS!R1C1:R" & row_count & "C" & col_count If Dir(localSaveLocation, vbNormal) <> "" Then Kill localSaveLocation End If xlsBook.SaveAs FileName:=localSaveLocation Set xlsSheet = Nothing xlsBook.Close Set xlsBook = Nothing xlsApp.Quit Set xlsApp = Nothing DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "DSRT_TEMP", localSaveLocation, True, "ERS" numOfChangesDSRT = DCount("ID", "changed_records") DoCmd.RunSQL "update ers_local inner join changed_records on changed_records.id = ers_local.id Set last_updated = Date();" DoCmd.RunSQL "update ers_local inner join dsrt_temp on dsrt_temp.id = ers_local.id Set source = 'DSRT';" DoCmd.RunSQL "DELETE FROM [dsrt_ers] WHERE dsrt_ers.id in (select id from ers_local where source = 'DSRT');" DoCmd.RunSQL "INSERT INTO DSRT_ERS SELECT * FROM DSRT_TEMP" DoCmd.RunSQL "DROP TABLE DSRT_TEMP;" DoCmd.Requery DoCmd.Hourglass False End Sub