app hangs (1 Viewer)

abenitez77

Registered User.
Local time
Today, 10:02
Joined
Apr 29, 2010
Messages
141
My app is hanging when I try to close an excel workbook. I am linking an excel file and when I am done processing and want to close the workbook, the app hangs. What am I not doing right?

It hangs on this line:
wkb.Close


Code:
Dim objXL As New Excel.Application
   Dim wkb As Excel.Workbook
   Dim wks As Excel.Sheets
   Set db = CurrentDb
   Dim tdf As DAO.TableDef
   Dim fld As DAO.field
   Dim i As Integer
   Dim x As Integer
   Dim ShtCount As Integer

   PathFilename = Right(strFileName, Len(strFileName) - InStrRev(strFileName, "\"))
   shortFilename = Left(PathFilename, (InStr(PathFilename, ".") - 1))

   Set wkb = objXL.Workbooks.Open(strFileName)
   ShtCount = wkb.Sheets.count
   
   i = 1
   x = 1

   For Each wks In wkb.Worksheets
        'Progress Bar :::::::::::::::::::::::::::::::::::::
'        RetVal = SysCmd(acSysCmdInitMeter, "Linking FILE: " & PathFilename & " - SHEET: " & Trim(str(x)) & " of " & Trim(str(ShtCount)), ShtCount)
        'Update the progress meter.
'        RetVal = SysCmd(acSysCmdUpdateMeter, i)
        
        ' Get the Sheet Order
        wksindex = wks.Index
        
        ' Link each sheet of the entire Spreadsheet file -----------------------
        DoCmd.TransferSpreadsheet acLink, , _
              "TmpLinkXLS", strFileName, False, wks.Name & "$"
        
        ' Get the list of field names
        Set tdf = db.TableDefs("TmpLinkXLS")
        ' ---- Pause .5 second ------
        Const cTIME = 500 'in MilliSeconds
        
        Call sSleep(cTIME)
        
        tdf.RefreshLink
        ' ---- Pause .5 second ------
        Call sSleep(cTIME)
        
        myfields = ""
        MyLen = ""
        For Each fld In tdf.Fields
            myfields = myfields & "[" & fld.Name & "],"
            MyLen = MyLen & "Len(Trim(x1." & fld.Name & ")) > 0 OR "
        Next
        
        MyLen = Mid(MyLen, 1, Len(MyLen) - 3)
        
        i = i + 1
 '       RetVal = SysCmd(acSysCmdInitMeter, "Inserting FILE: " & PathFilename & " - SHEET: " & Trim(str(x)) & " of " & Trim(str(ShtCount)), ShtCount)
        
        'Update the progress meter.
 '       RetVal = SysCmd(acSysCmdUpdateMeter, i)
        
        ' Insert the data from the sheet into the local XLSData Table --------------------------
        strsql = "Insert Into XLSData(" & myfields & "Fullimagepath,TabName,xlsFileName,SheetOrder,Hdrid" & ") " & _
                    " Select " & myfields & Chr(34) & strFileName & Chr(34) & " as Fullimagepath, " & Chr(34) & wks.Name & Chr(34) & " as TabName, " & Chr(34) & shortFilename & Chr(34) & " as xlsfilename, " & Chr(34) & wksindex & Chr(34) & " as SheetOrder,  " & Chr(34) & Hdrid & Chr(34) & " as Hdrid" & _
                    " From TmpLinkXLS As x1 " & _
                    " Where " & MyLen
        CurrentDb.Execute strsql, dbFailOnError
        
        ' ---- Pause .5 second ------
        'Const cTIME = 1000 'in MilliSeconds
        Call sSleep(cTIME)
        
        i = i + 1
'        RetVal = SysCmd(acSysCmdInitMeter, "Dropping TmpLinkXLS", ShtCount)
        'Update the progress meter.
'        RetVal = SysCmd(acSysCmdUpdateMeter, i)
        
        If TableExists("TmpLinkXLS") Then
            DoCmd.DeleteObject acTable, "TmpLinkXLS"
            'CurrentDb.Execute "Drop Table TmpLinkXLS", dbFailOnError
        End If
        
        Set tdf = Nothing
        
        RetVal = SysCmd(acSysCmdInitMeter, " ", 0)
        RetVal = SysCmd(acSysCmdRemoveMeter)
        
        i = 1
        x = x + 1
   Next

   'Tidy up
   Set tdf = Nothing
   Set db = Nothing
   wkb.Close
   Set wkb = Nothing
   objXL.Quit
   Set objXL = Nothing
 
Last edited:

abenitez77

Registered User.
Local time
Today, 10:02
Joined
Apr 29, 2010
Messages
141
I found my answer...I had to add false at the end of wks.close:

wks.close False
 

Users who are viewing this thread

Top Bottom