Question

我遇到了这段代码的问题。如果我重新启动计算机并运行它，它工作正常，但一旦代码运行一旦它开始导致错误。我要么得到“保存错误”或“管理错误”，因为文件（原始文件或其他文件）是不可访问的。我有时可以从任务管理器关闭后台excel程序来修复它（但并非总是如此）

该代码的目的是从Internet下载excel表并将新行（并将旧行更新）添加到ms-access数据库。

特殊情况是我无法看到任何逻辑错误的趋势。

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

要非常小心地正确打开和关闭Excel对象：

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

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

1 个答案: