CODEWITHSUNDEEP
excelms-accessvba
Chris Chevalier
Chris Chevalier

Reputation: 650

VBA keeping excel files locked from myself after code

I've been running into issues with this code. It works fine if I restart the computer and run it, but once the code has been run once it starts to cause errors. I will either get either the "save error" or the "admin error" because the file (either the original or the other) is un-accessible. I can sometimes close down background excel programs from the task-manager to fix it (but not always)

The code's purpose is to download an excel sheet off the internet and add the new rows (and update the old rows) to an ms-access Database.

Whats peculiar is I haven't been able to see any trend with the logical errors.

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

Upvotes: 0

Views: 2413

Answers (1)

Gustav
Gustav

Reputation: 55816

Be very careful opening and closing the Excel objects correctly:

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

Upvotes: 2

Related Questions