abenitez77
Registered User.
- Local time
- Today, 04:48
- 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
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: