Excel file locked after reading in Access 2

[PeDa]

I use the following code to open an Excel spreadsheet in my Access application:

Dim objXl As Object, objWkb As Object
Set objXl = New Excel.Application
MyExcelFile = <<path>>
Set objWkb = objXl.Workbooks.Open(MyExcelFile)
...
do things
...
Set objWkb = Nothing
objXl.Quit
Set objXl = Nothing

After leaving Access my Excel file is still locked; what am I doing wrong?

 

[PHV]

what am I doing wrong?
perhaps here ?
...do things...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[PeDa]

Sorry for niet being explicit enough. The only "things" I am doing, is reading in values of Cells(x,y). After closing the Access application I leave an Excel process running which I have to close by hand using the Task manager.

 

[PHV]

Why not posting the WHOLE code ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[bubba100]

I see where you open the workbook, but don't see where you close the workbook. Please post your code.

 

[PeDa]

Here is the whole code (I am basically reading a spreadsheet into an Access table, and doing some reformatting on the fly):

Option Compare Database
Option Explicit

Private Sub butImporteer_Click()
Dim objXl As Object, objWkb As Object
Dim dbf As Database, rst As Recordset, MyLine As String, i As Integer, MyName As String, MyOntvangst As String
Dim sh As Integer, MyRow As Integer, MyColumn As Integer, MyString As String, MyCASNr As String, Temp As String
Dim MyBewaarcondities As String, MyExcelFile As String, MyLogFile As String, MyVerval As String
Dim Overslaan As Boolean

' DoCmd.Hourglass True
Close #1
MyLogFile = "S:\Afdelingen\Kwaliteit, Arbo en Milieu\CBS_Conversie\LeidenLog.txt"
Open MyLogFile For Output As #1
Set dbf = CurrentDb
Set objXl = New Excel.Application
MyExcelFile = "S:\Afdelingen\Kwaliteit, Arbo en Milieu\CBS_Conversie\Leiden.xls"
Set objWkb = objXl.Workbooks.Open(MyExcelFile)
Set rst = dbf.OpenRecordset("tbCBS_Actueel", dbOpenDynaset)
For sh = 1 To 1
  Worksheets(sh).Activate
  MyRow = 4
  Do While (Len(Cells(MyRow, 1)) > 0) And (Cells(MyRow, 1) <> "Ethanol (VOORBEELD)")
    Overslaan = False
    If Not (IsNumeric(Cells(MyRow, 3))) Then
      Print #1, "Ruimte:" & Cells(MyRow, 16) & " volgnummer:" & Cells(MyRow, 3) & "..." & "ongeldig (niet numeriek) volgnummer " & Cells(MyRow, 3) & "(wordt overgeslagen)"
      Overslaan = True
    End If
    If Not (IsNumeric(Cells(MyRow, 11))) Then
      Print #1, "Ruimte:" & Cells(MyRow, 16) & " volgnummer:" & Cells(MyRow, 3) & "..." & "ongeldig (niet numeriek) hoeveelheid " & Cells(MyRow, 11) & "(wordt overgeslagen)"
      Overslaan = True
    End If
    If Len(Trim(Cells(MyRow, 9))) > 30 Then
      Print #1, "Ruimte:" & Cells(MyRow, 16) & " volgnummer:" & Cells(MyRow, 3) & "..." & "batchnummer te lang " & Cells(MyRow, 9) & "(wordt afgekort)"
    End If
    If Len(Trim(Cells(MyRow, 10))) > 30 Then
      Print #1, "Ruimte:" & Cells(MyRow, 16) & " volgnummer:" & Cells(MyRow, 3) & "..." & "batchnummer te lang " & Cells(MyRow, 9) & "(wordt afgekort)"
    End If
    MyCASNr = Trim(Cells(MyRow, 5))
    If Len(MyCASNr) > 4 Then
      If Mid(MyCASNr, Len(MyCASNr) - 4, 1) = "-" Then
        MyCASNr = Left(MyCASNr, Len(MyCASNr) - 5) & Mid(MyCASNr, Len(MyCASNr) - 3)
      End If
      If Mid(MyCASNr, Len(MyCASNr) - 1, 1) = "-" Then
        MyCASNr = Left(MyCASNr, Len(MyCASNr) - 2) & Right(MyCASNr, 1)
      End If
      If Not (IsNumeric(MyCASNr)) Then
        Print #1, "Ruimte:" & Cells(MyRow, 16) & " volgnummer:" & Cells(MyRow, 3) & "..." & "ongeldig CAS-nr " & MyCASNr
        MyCASNr = ""
      End If
    Else
      Print #1, "Ruimte:" & Cells(MyRow, 16) & " volgnummer:" & Cells(MyRow, 3) & "..." & "ongeldig CAS-nr " & MyCASNr
      MyCASNr = ""
    End If
    Temp = Trim(Cells(MyRow, 2).Text)
    If Len(Temp) < 8 Then
      Print #1, "Ruimte:" & Cells(MyRow, 16) & " volgnummer:" & Cells(MyRow, 3) & "..." & "ontvangstdatum ontbreekt"
      MyOntvangst = "19500101"
    Else
      If Val(Right(Temp, 2)) < 50 Then
        MyOntvangst = "20" & Right(Temp, 2)
      Else
        MyOntvangst = "19" & Right(Temp, 2)
      End If
      Select Case Mid(Temp, Len(Temp) - 5, 3)
        Case "jan"
          MyOntvangst = MyOntvangst & "01"
        Case "feb"
          MyOntvangst = MyOntvangst & "02"
        Case "mar"
          MyOntvangst = MyOntvangst & "03"
        Case "mrt"
          MyOntvangst = MyOntvangst & "03"
        Case "apr"
          MyOntvangst = MyOntvangst & "04"
        Case "mei"
          MyOntvangst = MyOntvangst & "07"
        Case "jun"
          MyOntvangst = MyOntvangst & "06"
        Case "jul"
          MyOntvangst = MyOntvangst & "07"
        Case "aug"
          MyOntvangst = MyOntvangst & "08"
        Case "sep"
          MyOntvangst = MyOntvangst & "09"
        Case "oct"
          MyOntvangst = MyOntvangst & "10"
        Case "nov"
          MyOntvangst = MyOntvangst & "11"
        Case "dec"
          MyOntvangst = MyOntvangst & "12"
        Case Else
          Print #1, "Ruimte:" & Cells(MyRow, 16) & " volgnummer:" & Cells(MyRow, 3) & "..." & "ongeldig ontvangstdatum " & MyOntvangst
          MyOntvangst = MyOntvangst & "01"
      End Select
      If Len(Temp) = 8 Then
        MyOntvangst = MyOntvangst & "0" & Left(Temp, 1)
      Else
        MyOntvangst = MyOntvangst & Left(Temp, 2)
      End If
    End If
    Temp = Trim(Cells(MyRow, 13).Text)
    If Len(Temp) <> 6 Then
      Print #1, "Ruimte:" & Cells(MyRow, 16) & " volgnummer:" & Cells(MyRow, 3) & "..." & "ongeldig vervaldatum " & Temp
      MyVerval = "20991231"
    Else
      Select Case Left(Temp, 3)
        Case "jan"
          MyVerval = "20" & Right(Temp, 2) & "0101"
        Case "feb"
          MyVerval = "20" & Right(Temp, 2) & "0201"
        Case "mar"
          MyVerval = "20" & Right(Temp, 2) & "0301"
        Case "mrt"
          MyVerval = "20" & Right(Temp, 2) & "0301"
        Case "apr"
          MyVerval = "20" & Right(Temp, 2) & "0401"
        Case "mei"
          MyVerval = "20" & Right(Temp, 2) & "0501"
        Case "jun"
          MyVerval = "20" & Right(Temp, 2) & "0601"
        Case "jul"
          MyVerval = "20" & Right(Temp, 2) & "0701"
        Case "aug"
          MyVerval = "20" & Right(Temp, 2) & "0801"
        Case "sep"
          MyVerval = "20" & Right(Temp, 2) & "0901"
        Case "oct"
          MyVerval = "20" & Right(Temp, 2) & "1001"
        Case "nov"
          MyVerval = "20" & Right(Temp, 2) & "1101"
        Case "dec"
          MyVerval = "20" & Right(Temp, 2) & "1201"
        Case Else
          Print #1, "Ruimte:" & Cells(MyRow, 16) & " volgnummer:" & Cells(MyRow, 3) & "..." & "ongeldig ontvangstdatum " & Temp
          MyVerval = "20991231"
      End Select
    End If
    MyBewaarcondities = Cells(MyRow, 12)
    If Len(MyBewaarcondities) > 10 Then
      MyBewaarcondities = Left(MyBewaarcondities, 10)
    End If
    If Not Overslaan Then
      With rst
        .AddNew
        !CBS_VERZNR = 100
        !VOLGNummer = Cells(MyRow, 3)
        !Eigen_Nummer = Cells(MyRow, 4)
        If IsNumeric(MyCASNr) Then
          !CAS_NUMMER = MyCASNr
        End If
        !NAAM_VOORVOEGSEL = ""
        !NAAM_CHEMICALIE = Cells(MyRow, 6)
        !LEVERANCIER = Cells(MyRow, 7)
        !BESTELNUMMER = ""
        !KWALITEIT = ""
        !PERCENTAGE = 0
        !DATUM_ONTVANGST = MyOntvangst
        !DATUM_EXP_VERPAKKING = Null
        If Len(Cells(MyRow, 9)) < 31 Then
          !CHARGE_NUMMER = Cells(MyRow, 9)
        Else
          !CHARGE_NUMMER = Left(Cells(MyRow, 9), 30)
        End If
        !OPSLAG_LOKATIE = Cells(MyRow, 16)
        !OPSLAG_BERGRUIMTE = Cells(MyRow, 17)
        !HOEVEELHEID = Cells(MyRow, 11) * 10
        !Eenheid = Cells(MyRow, 10)
        !HOUDBAARHEID = -1
        !BEWAARCONDITIES = MyBewaarcondities
        !VervalDatum = MyVerval
        .Update
      End With
    End If
    MyRow = MyRow + 1
  Loop
Next sh
Set objWkb = Nothing
objXl.Quit
Set objXl = Nothing
Close #1
DoCmd.Hourglass False
End Sub

 

[PHV]

You have LOT of unqualified excel stuff !
eg, replace this:
Worksheets(sh).Activate
with this:
objWkb.Worksheets(sh).Activate

And replace all Cells(... with objWkb.Activesheet.Cells(...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[PeDa]

Thank you, PHS, that did the trick (and I now appreciate the importance of doing this)

 

[dhookom]

PeDa,
Consider awarding a star to PH. He fixed your issue and taught you (and others reading this thread) something. You can click the "Thank PHV..." link. This also marks the thread as successfully answered.

Duane
Hook'D on Access
MS Access MVP