PC Review


Reply
Thread Tools Rate Thread

Access automation not releasing Excel

 
 
Dale Fye
Guest
Posts: n/a
 
      18th Apr 2008
I've seen other posts and have been working through them to resolve my
problem. The following code (I've cut some of the fluff) works to loop
through sheets of an Excel workbook and import the data into an Access
database. But will not release Excel. Any help would be greatly appreciated.

Public Sub ExcelLitReviewImport(MyFilename)

Dim xlApp As Excel.Application
Dim wbk As Excel.Workbook
Dim sht As Excel.Worksheet
Dim rng As Excel.Range

Dim intSheetNum As Integer, strShtName As String, intRowPointer As Integer
Dim strImportRange As String
Dim qdf As DAO.QueryDef
Dim frm As Form

On Error GoTo ExcelLitReviewImportError

Set frm = Forms("frm_Import_Lit_Review")
CurrentDb.Execute "DELETE * FROM tbl_Temp_Lit_Review", dbFailOnError

'Open Excel and open the workbook to be imported,
frm.lbl_Routine.Visible = True
frm.lbl_Routine.Caption = "Updating Excel file column headers"
DoEvents
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

'Open the workbook
Set wbk = xlApp.Workbooks.Open(Filename:=MyFilename, ReadOnly:=False)

'Loop through all of the numbered sheets
DoCmd.Hourglass True
For intSheetNum = 4 To wbk.Sheets.Count

DoEvents

Set sht = wbk.Sheets(intSheetNum)
sht.Activate
strShtName = sht.Name

'If sheet has data, reformat the header row,
'change the worksheet name, import the worksheet
'then change the worksheet name back
If intRowPointer > 1 Then

'Change the column names to correspond with those in
'tbl_Temp_Lit_Review
sht.Cells(1, 1) = "Task"
sht.Cells(1, 1).Hyperlinks.Delete
sht.Cells(1, 2) = "Sub_Task"
sht.Cells(1, 3) = "Source"
sht.Cells(1, 4) = "Pg_Para"
sht.Cells(1, 5) = "Classification"
sht.Cells(1, 6) = "Potential_Gap"
sht.Cells(1, 7) = "D"
sht.Cells(1, 8) = "O"
sht.Cells(1, 9) = "T"
sht.Cells(1, 10) = "M"
sht.Cells(1, 11) = "L"
sht.Cells(1, 12) = "P"
sht.Cells(1, 13) = "F"
sht.Cells(1, 14) = "P2"
sht.Cells(1, 15) = "Reviewer"

'Remove header row formatting
Set rng = Range("A1:O1")
rng.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Set rng = Nothing

'Worksheets are name 1.2.1, 1.3.1, ....
'Could not get method to work with periods in worksheet names
'so changed each sheets name, saved it, imported it, then
'changed it back
sht.Name = "ImportThis"
wbk.Save
strImportRange = "ImportThis!A1:O" & intRowPointer
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl_Temp_Lit_Review", Filename, True,
strImportRange
sht.Name = strShtName

End If
Next

wbk.Save
wbk.Close
xlApp.Quit

End sub

--

email address is invalid
Please reply to newsgroup only.

 
Reply With Quote
 
 
 
 
Norman Yuan
Guest
Posts: n/a
 
      18th Apr 2008
The most poosible reason for Excel being left behind, even Quit() is called,
is because in the current code executing scope there is still variable
referring to objet(s) in Excel object model.

In you case, they are "wbk", "sht" and "rng" variables. at the point when
you call xlApp.Quit(), these 3 variables are still in scope and refers
tothen Workbook, the last Worksheet and the last Range they were assigned
to. They only go out of scope at the end of the Sub, after the Quit() call.

So, you need to explicitly set them (or any variable in scope that points to
an object in Excel object model) to Nothing before calling xlApp.Quit().

This structure of code makes thing easier and clearer:

Public Sub DoExcelAutomation(fileName As String)

Dim xlApp As Excel.Application

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

'All variables referring to objects in Excel object model is
'local to DoProcess() method and will go out of scope
'without need to be set to Nothing explicitly

DoProcess xlApp,fileName

xlApp.Quit

End

Private Sub DoProcess(xlApp As Excel.Application, fileName As String)

Dim wbk As Workbook
Dim sht As Worksheet
Dim rng As Range

''Do whatever

''Following code is not necessary
'Set wbk=Nothing
'Set sht=Nothing
'Set rng=Nothing

End


"Dale Fye" <(E-Mail Removed)> wrote in message
news:7FCA9EB1-1071-40FB-8A83-(E-Mail Removed)...
> I've seen other posts and have been working through them to resolve my
> problem. The following code (I've cut some of the fluff) works to loop
> through sheets of an Excel workbook and import the data into an Access
> database. But will not release Excel. Any help would be greatly
> appreciated.
>
> Public Sub ExcelLitReviewImport(MyFilename)
>
> Dim xlApp As Excel.Application
> Dim wbk As Excel.Workbook
> Dim sht As Excel.Worksheet
> Dim rng As Excel.Range
>
> Dim intSheetNum As Integer, strShtName As String, intRowPointer As
> Integer
> Dim strImportRange As String
> Dim qdf As DAO.QueryDef
> Dim frm As Form
>
> On Error GoTo ExcelLitReviewImportError
>
> Set frm = Forms("frm_Import_Lit_Review")
> CurrentDb.Execute "DELETE * FROM tbl_Temp_Lit_Review", dbFailOnError
>
> 'Open Excel and open the workbook to be imported,
> frm.lbl_Routine.Visible = True
> frm.lbl_Routine.Caption = "Updating Excel file column headers"
> DoEvents
> Set xlApp = CreateObject("Excel.Application")
> xlApp.Visible = True
>
> 'Open the workbook
> Set wbk = xlApp.Workbooks.Open(Filename:=MyFilename, ReadOnly:=False)
>
> 'Loop through all of the numbered sheets
> DoCmd.Hourglass True
> For intSheetNum = 4 To wbk.Sheets.Count
>
> DoEvents
>
> Set sht = wbk.Sheets(intSheetNum)
> sht.Activate
> strShtName = sht.Name
>
> 'If sheet has data, reformat the header row,
> 'change the worksheet name, import the worksheet
> 'then change the worksheet name back
> If intRowPointer > 1 Then
>
> 'Change the column names to correspond with those in
> 'tbl_Temp_Lit_Review
> sht.Cells(1, 1) = "Task"
> sht.Cells(1, 1).Hyperlinks.Delete
> sht.Cells(1, 2) = "Sub_Task"
> sht.Cells(1, 3) = "Source"
> sht.Cells(1, 4) = "Pg_Para"
> sht.Cells(1, 5) = "Classification"
> sht.Cells(1, 6) = "Potential_Gap"
> sht.Cells(1, 7) = "D"
> sht.Cells(1, 8) = "O"
> sht.Cells(1, 9) = "T"
> sht.Cells(1, 10) = "M"
> sht.Cells(1, 11) = "L"
> sht.Cells(1, 12) = "P"
> sht.Cells(1, 13) = "F"
> sht.Cells(1, 14) = "P2"
> sht.Cells(1, 15) = "Reviewer"
>
> 'Remove header row formatting
> Set rng = Range("A1:O1")
> rng.Select
> Selection.Borders(xlDiagonalDown).LineStyle = xlNone
> Selection.Borders(xlDiagonalUp).LineStyle = xlNone
> Selection.Borders(xlEdgeLeft).LineStyle = xlNone
> Selection.Borders(xlEdgeTop).LineStyle = xlNone
> Selection.Borders(xlEdgeBottom).LineStyle = xlNone
> Selection.Borders(xlEdgeRight).LineStyle = xlNone
> Selection.Borders(xlInsideVertical).LineStyle = xlNone
> Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
> Set rng = Nothing
>
> 'Worksheets are name 1.2.1, 1.3.1, ....
> 'Could not get method to work with periods in worksheet names
> 'so changed each sheets name, saved it, imported it, then
> 'changed it back
> sht.Name = "ImportThis"
> wbk.Save
> strImportRange = "ImportThis!A1:O" & intRowPointer
> DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
> "tbl_Temp_Lit_Review", Filename,
> True,
> strImportRange
> sht.Name = strShtName
>
> End If
> Next
>
> wbk.Save
> wbk.Close
> xlApp.Quit
>
> End sub
>
> --
>
> email address is invalid
> Please reply to newsgroup only.
>


 
Reply With Quote
 
Dale Fye
Guest
Posts: n/a
 
      18th Apr 2008
Norman,

Thanks for the suggestion. I tried it, but that doesn't seem to do it
either. I even explicitly set the rng, sht, and wbk objects to Nothing
before exiting the subroutine, but Excel is still not being released. New
code looks like:

Public Sub ExcelLitReviewImport(Filename)

Dim xlApp As Object

On Error GoTo ExcelLitReviewImportError

'Open Excel
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

'Call the details routine
Call ExcelLitReviewImportDetails(xlApp, Filename)

ExcelLitReviewImportExit:
xlApp.Quit
Set xlApp = Nothing

DoCmd.Hourglass False
Exit Sub

ExcelLitReviewImportError:
If Err.Number = 3022 Then Resume Next
MsgBox Err.Number & vbCrLf & Err.Description, vbInformation + vbOKOnly,
"Error:ExcelLitReviewImport"
Debug.Print "ExcelLitReviewImport", Err.Number, Err.Description
Resume ExcelLitReviewImportExit

End Sub
_____________________
Public Sub ExcelLitReviewImportDetails(xlApp As Object, Filename)

Dim wbk As Object
Dim sht As Object
Dim rng As Object

Dim intSheetNum As Integer, strShtName As String, intRowPointer As Integer
Dim strImportRange As String
Dim frm As Form

On Error GoTo ExcelLitReviewImportDetailsError

Set frm = Forms("frm_Import_Lit_Review")
CurrentDb.Execute "DELETE * FROM tbl_Temp_Lit_Review", dbFailOnError

'Open the workbook
Set wbk = xlApp.Workbooks.Open(Filename:=Filename, ReadOnly:=False)

'Loop through all of the numbered sheets
DoCmd.Hourglass True
For intSheetNum = 4 To wbk.Sheets.Count

Set sht = wbk.Sheets(intSheetNum)
sht.Activate
strShtName = sht.Name
frm.lbl_Routine.Caption = "Importing data from worksheet '" _
& strShtName & "'"
DoEvents

'Fill in the sub-task number for all rows with data
intRowPointer = 1
While sht.Cells(intRowPointer + 1, 3) <> ""
intRowPointer = intRowPointer + 1
sht.Cells(intRowPointer, 2) = strShtName
Wend

'If sheet has data:
' reformat the header row,
' change the worksheet name,
' import the worksheet
' then change the worksheet name back
If intRowPointer > 1 Then

'Change the column names to correspond with those in
'tbl_Temp_Lit_Review
sht.Cells(1, 1) = "Task"
sht.Cells(1, 1).Hyperlinks.Delete
sht.Cells(1, 2) = "Sub_Task"
sht.Cells(1, 3) = "Source"
sht.Cells(1, 4) = "Pg_Para"
sht.Cells(1, 5) = "Classification"
sht.Cells(1, 6) = "Potential_Gap"
sht.Cells(1, 7) = "D"
sht.Cells(1, 8) = "O"
sht.Cells(1, 9) = "T"
sht.Cells(1, 10) = "M"
sht.Cells(1, 11) = "L"
sht.Cells(1, 12) = "P"
sht.Cells(1, 13) = "F"
sht.Cells(1, 14) = "P2"
sht.Cells(1, 15) = "Reviewer"

'Remove header row formatting
Set rng = sht.Range("A1:O1")
rng.Select
xlApp.Selection.Borders(5).LineStyle = -4142
xlApp.Selection.Borders(6).LineStyle = -4142
xlApp.Selection.Borders(7).LineStyle = -4142
xlApp.Selection.Borders(8).LineStyle = -4142
xlApp.Selection.Borders(9).LineStyle = -4142
xlApp.Selection.Borders(10).LineStyle = -4142
xlApp.Selection.Borders(11).LineStyle = -4142
xlApp.Selection.Borders(12).LineStyle = -4142
Set rng = Nothing

sht.Name = "ImportThis"
wbk.Save
strImportRange = "ImportThis!A1:O" & intRowPointer
DoCmd.TransferSpreadsheet acImport, _

acSpreadsheetTypeExcel9, _
"tbl_Temp_Lit_Review", _
Filename, _
True, strImportRange
sht.Name = strShtName

End If
Next

ExcelLitReviewImportDetailsExit:
wbk.Save
Set rng = Nothing
Set sht = Nothing
wbk.Close
Set wbk = Nothing

Exit Sub

ExcelLitReviewImportDetailsError:
If Err.Number = 3022 Then Resume Next
MsgBox Err.Number & vbCrLf & Err.Description, _
vbInformation + vbOKOnly, _
"Error:ExcelLitReviewDetailsImport"
Debug.Print "ExcelLitReviewDetailsImport", Err.Number, Err.Description
Resume ExcelLitReviewImportDetailsExit

End Sub


Dale

--

email address is invalid
Please reply to newsgroup only.



"Norman Yuan" wrote:

> The most poosible reason for Excel being left behind, even Quit() is called,
> is because in the current code executing scope there is still variable
> referring to objet(s) in Excel object model.
>
> In you case, they are "wbk", "sht" and "rng" variables. at the point when
> you call xlApp.Quit(), these 3 variables are still in scope and refers
> tothen Workbook, the last Worksheet and the last Range they were assigned
> to. They only go out of scope at the end of the Sub, after the Quit() call.
>
> So, you need to explicitly set them (or any variable in scope that points to
> an object in Excel object model) to Nothing before calling xlApp.Quit().
>
> This structure of code makes thing easier and clearer:
>
> Public Sub DoExcelAutomation(fileName As String)
>
> Dim xlApp As Excel.Application
>
> Set xlApp = CreateObject("Excel.Application")
> xlApp.Visible = True
>
> 'All variables referring to objects in Excel object model is
> 'local to DoProcess() method and will go out of scope
> 'without need to be set to Nothing explicitly
>
> DoProcess xlApp,fileName
>
> xlApp.Quit
>
> End
>
> Private Sub DoProcess(xlApp As Excel.Application, fileName As String)
>
> Dim wbk As Workbook
> Dim sht As Worksheet
> Dim rng As Range
>
> ''Do whatever
>
> ''Following code is not necessary
> 'Set wbk=Nothing
> 'Set sht=Nothing
> 'Set rng=Nothing
>
> End
>
>
> "Dale Fye" <(E-Mail Removed)> wrote in message
> news:7FCA9EB1-1071-40FB-8A83-(E-Mail Removed)...
> > I've seen other posts and have been working through them to resolve my
> > problem. The following code (I've cut some of the fluff) works to loop
> > through sheets of an Excel workbook and import the data into an Access
> > database. But will not release Excel. Any help would be greatly
> > appreciated.
> >
> > Public Sub ExcelLitReviewImport(MyFilename)
> >
> > Dim xlApp As Excel.Application
> > Dim wbk As Excel.Workbook
> > Dim sht As Excel.Worksheet
> > Dim rng As Excel.Range
> >
> > Dim intSheetNum As Integer, strShtName As String, intRowPointer As
> > Integer
> > Dim strImportRange As String
> > Dim qdf As DAO.QueryDef
> > Dim frm As Form
> >
> > On Error GoTo ExcelLitReviewImportError
> >
> > Set frm = Forms("frm_Import_Lit_Review")
> > CurrentDb.Execute "DELETE * FROM tbl_Temp_Lit_Review", dbFailOnError
> >
> > 'Open Excel and open the workbook to be imported,
> > frm.lbl_Routine.Visible = True
> > frm.lbl_Routine.Caption = "Updating Excel file column headers"
> > DoEvents
> > Set xlApp = CreateObject("Excel.Application")
> > xlApp.Visible = True
> >
> > 'Open the workbook
> > Set wbk = xlApp.Workbooks.Open(Filename:=MyFilename, ReadOnly:=False)
> >
> > 'Loop through all of the numbered sheets
> > DoCmd.Hourglass True
> > For intSheetNum = 4 To wbk.Sheets.Count
> >
> > DoEvents
> >
> > Set sht = wbk.Sheets(intSheetNum)
> > sht.Activate
> > strShtName = sht.Name
> >
> > 'If sheet has data, reformat the header row,
> > 'change the worksheet name, import the worksheet
> > 'then change the worksheet name back
> > If intRowPointer > 1 Then
> >
> > 'Change the column names to correspond with those in
> > 'tbl_Temp_Lit_Review
> > sht.Cells(1, 1) = "Task"
> > sht.Cells(1, 1).Hyperlinks.Delete
> > sht.Cells(1, 2) = "Sub_Task"
> > sht.Cells(1, 3) = "Source"
> > sht.Cells(1, 4) = "Pg_Para"
> > sht.Cells(1, 5) = "Classification"
> > sht.Cells(1, 6) = "Potential_Gap"
> > sht.Cells(1, 7) = "D"
> > sht.Cells(1, 8) = "O"
> > sht.Cells(1, 9) = "T"
> > sht.Cells(1, 10) = "M"
> > sht.Cells(1, 11) = "L"
> > sht.Cells(1, 12) = "P"
> > sht.Cells(1, 13) = "F"
> > sht.Cells(1, 14) = "P2"
> > sht.Cells(1, 15) = "Reviewer"
> >
> > 'Remove header row formatting
> > Set rng = Range("A1:O1")
> > rng.Select
> > Selection.Borders(xlDiagonalDown).LineStyle = xlNone
> > Selection.Borders(xlDiagonalUp).LineStyle = xlNone
> > Selection.Borders(xlEdgeLeft).LineStyle = xlNone
> > Selection.Borders(xlEdgeTop).LineStyle = xlNone
> > Selection.Borders(xlEdgeBottom).LineStyle = xlNone
> > Selection.Borders(xlEdgeRight).LineStyle = xlNone
> > Selection.Borders(xlInsideVertical).LineStyle = xlNone
> > Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
> > Set rng = Nothing
> >
> > 'Worksheets are name 1.2.1, 1.3.1, ....
> > 'Could not get method to work with periods in worksheet names
> > 'so changed each sheets name, saved it, imported it, then
> > 'changed it back
> > sht.Name = "ImportThis"
> > wbk.Save
> > strImportRange = "ImportThis!A1:O" & intRowPointer
> > DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
> > "tbl_Temp_Lit_Review", Filename,
> > True,
> > strImportRange
> > sht.Name = strShtName
> >
> > End If
> > Next
> >
> > wbk.Save
> > wbk.Close
> > xlApp.Quit
> >
> > End sub
> >
> > --
> >
> > email address is invalid
> > Please reply to newsgroup only.
> >

>
>

 
Reply With Quote
 
Norman Yuan
Guest
Posts: n/a
 
      18th Apr 2008
I guess it is because you use "DoCmd.TransferSpreadsheet()", which
internally holds reference(s) to object(s) in Excel model.

You could verify it by commentting out the line of code. Since you have
already automated Excel and loop through worksheet/ranges/cells, why do you
need to use DoCmd.TransferSpreadsheet()? Since you already opened Worksheet
and have all data in the sheet in hand, and you are in Access, why not put
the data directly into the table with DAO?

If you have to use DoCmd.TransferSpreadsheet(), you could try to automate
Excel and manipulate sheet/range/cell first, then save the sheet and close
Excel; after that you call DoCmd.TransferSpreadsheet(). Not sure if it
works, but worth trying.


"Dale Fye" <(E-Mail Removed)> wrote in message
news:1E69EBFE-A3BC-41AA-89A1-(E-Mail Removed)...
> Norman,
>
> Thanks for the suggestion. I tried it, but that doesn't seem to do it
> either. I even explicitly set the rng, sht, and wbk objects to Nothing
> before exiting the subroutine, but Excel is still not being released. New
> code looks like:
>
> Public Sub ExcelLitReviewImport(Filename)
>
> Dim xlApp As Object
>
> On Error GoTo ExcelLitReviewImportError
>
> 'Open Excel
> Set xlApp = CreateObject("Excel.Application")
> xlApp.Visible = True
>
> 'Call the details routine
> Call ExcelLitReviewImportDetails(xlApp, Filename)
>
> ExcelLitReviewImportExit:
> xlApp.Quit
> Set xlApp = Nothing
>
> DoCmd.Hourglass False
> Exit Sub
>
> ExcelLitReviewImportError:
> If Err.Number = 3022 Then Resume Next
> MsgBox Err.Number & vbCrLf & Err.Description, vbInformation + vbOKOnly,
> "Error:ExcelLitReviewImport"
> Debug.Print "ExcelLitReviewImport", Err.Number, Err.Description
> Resume ExcelLitReviewImportExit
>
> End Sub
> _____________________
> Public Sub ExcelLitReviewImportDetails(xlApp As Object, Filename)
>
> Dim wbk As Object
> Dim sht As Object
> Dim rng As Object
>
> Dim intSheetNum As Integer, strShtName As String, intRowPointer As
> Integer
> Dim strImportRange As String
> Dim frm As Form
>
> On Error GoTo ExcelLitReviewImportDetailsError
>
> Set frm = Forms("frm_Import_Lit_Review")
> CurrentDb.Execute "DELETE * FROM tbl_Temp_Lit_Review", dbFailOnError
>
> 'Open the workbook
> Set wbk = xlApp.Workbooks.Open(Filename:=Filename, ReadOnly:=False)
>
> 'Loop through all of the numbered sheets
> DoCmd.Hourglass True
> For intSheetNum = 4 To wbk.Sheets.Count
>
> Set sht = wbk.Sheets(intSheetNum)
> sht.Activate
> strShtName = sht.Name
> frm.lbl_Routine.Caption = "Importing data from worksheet '" _
> & strShtName & "'"
> DoEvents
>
> 'Fill in the sub-task number for all rows with data
> intRowPointer = 1
> While sht.Cells(intRowPointer + 1, 3) <> ""
> intRowPointer = intRowPointer + 1
> sht.Cells(intRowPointer, 2) = strShtName
> Wend
>
> 'If sheet has data:
> ' reformat the header row,
> ' change the worksheet name,
> ' import the worksheet
> ' then change the worksheet name back
> If intRowPointer > 1 Then
>
> 'Change the column names to correspond with those in
> 'tbl_Temp_Lit_Review
> sht.Cells(1, 1) = "Task"
> sht.Cells(1, 1).Hyperlinks.Delete
> sht.Cells(1, 2) = "Sub_Task"
> sht.Cells(1, 3) = "Source"
> sht.Cells(1, 4) = "Pg_Para"
> sht.Cells(1, 5) = "Classification"
> sht.Cells(1, 6) = "Potential_Gap"
> sht.Cells(1, 7) = "D"
> sht.Cells(1, 8) = "O"
> sht.Cells(1, 9) = "T"
> sht.Cells(1, 10) = "M"
> sht.Cells(1, 11) = "L"
> sht.Cells(1, 12) = "P"
> sht.Cells(1, 13) = "F"
> sht.Cells(1, 14) = "P2"
> sht.Cells(1, 15) = "Reviewer"
>
> 'Remove header row formatting
> Set rng = sht.Range("A1:O1")
> rng.Select
> xlApp.Selection.Borders(5).LineStyle = -4142
> xlApp.Selection.Borders(6).LineStyle = -4142
> xlApp.Selection.Borders(7).LineStyle = -4142
> xlApp.Selection.Borders(8).LineStyle = -4142
> xlApp.Selection.Borders(9).LineStyle = -4142
> xlApp.Selection.Borders(10).LineStyle = -4142
> xlApp.Selection.Borders(11).LineStyle = -4142
> xlApp.Selection.Borders(12).LineStyle = -4142
> Set rng = Nothing
>
> sht.Name = "ImportThis"
> wbk.Save
> strImportRange = "ImportThis!A1:O" & intRowPointer
> DoCmd.TransferSpreadsheet acImport, _
>
> acSpreadsheetTypeExcel9, _
>
> "tbl_Temp_Lit_Review", _
> Filename, _
> True, strImportRange
> sht.Name = strShtName
>
> End If
> Next
>
> ExcelLitReviewImportDetailsExit:
> wbk.Save
> Set rng = Nothing
> Set sht = Nothing
> wbk.Close
> Set wbk = Nothing
>
> Exit Sub
>
> ExcelLitReviewImportDetailsError:
> If Err.Number = 3022 Then Resume Next
> MsgBox Err.Number & vbCrLf & Err.Description, _
> vbInformation + vbOKOnly, _
> "Error:ExcelLitReviewDetailsImport"
> Debug.Print "ExcelLitReviewDetailsImport", Err.Number, Err.Description
> Resume ExcelLitReviewImportDetailsExit
>
> End Sub
>
>
> Dale
>
> --
>
> email address is invalid
> Please reply to newsgroup only.
>
>
>
> "Norman Yuan" wrote:
>
>> The most poosible reason for Excel being left behind, even Quit() is
>> called,
>> is because in the current code executing scope there is still variable
>> referring to objet(s) in Excel object model.
>>
>> In you case, they are "wbk", "sht" and "rng" variables. at the point when
>> you call xlApp.Quit(), these 3 variables are still in scope and refers
>> tothen Workbook, the last Worksheet and the last Range they were assigned
>> to. They only go out of scope at the end of the Sub, after the Quit()
>> call.
>>
>> So, you need to explicitly set them (or any variable in scope that points
>> to
>> an object in Excel object model) to Nothing before calling xlApp.Quit().
>>
>> This structure of code makes thing easier and clearer:
>>
>> Public Sub DoExcelAutomation(fileName As String)
>>
>> Dim xlApp As Excel.Application
>>
>> Set xlApp = CreateObject("Excel.Application")
>> xlApp.Visible = True
>>
>> 'All variables referring to objects in Excel object model is
>> 'local to DoProcess() method and will go out of scope
>> 'without need to be set to Nothing explicitly
>>
>> DoProcess xlApp,fileName
>>
>> xlApp.Quit
>>
>> End
>>
>> Private Sub DoProcess(xlApp As Excel.Application, fileName As String)
>>
>> Dim wbk As Workbook
>> Dim sht As Worksheet
>> Dim rng As Range
>>
>> ''Do whatever
>>
>> ''Following code is not necessary
>> 'Set wbk=Nothing
>> 'Set sht=Nothing
>> 'Set rng=Nothing
>>
>> End
>>
>>
>> "Dale Fye" <(E-Mail Removed)> wrote in message
>> news:7FCA9EB1-1071-40FB-8A83-(E-Mail Removed)...
>> > I've seen other posts and have been working through them to resolve my
>> > problem. The following code (I've cut some of the fluff) works to loop
>> > through sheets of an Excel workbook and import the data into an Access
>> > database. But will not release Excel. Any help would be greatly
>> > appreciated.
>> >
>> > Public Sub ExcelLitReviewImport(MyFilename)
>> >
>> > Dim xlApp As Excel.Application
>> > Dim wbk As Excel.Workbook
>> > Dim sht As Excel.Worksheet
>> > Dim rng As Excel.Range
>> >
>> > Dim intSheetNum As Integer, strShtName As String, intRowPointer As
>> > Integer
>> > Dim strImportRange As String
>> > Dim qdf As DAO.QueryDef
>> > Dim frm As Form
>> >
>> > On Error GoTo ExcelLitReviewImportError
>> >
>> > Set frm = Forms("frm_Import_Lit_Review")
>> > CurrentDb.Execute "DELETE * FROM tbl_Temp_Lit_Review", dbFailOnError
>> >
>> > 'Open Excel and open the workbook to be imported,
>> > frm.lbl_Routine.Visible = True
>> > frm.lbl_Routine.Caption = "Updating Excel file column headers"
>> > DoEvents
>> > Set xlApp = CreateObject("Excel.Application")
>> > xlApp.Visible = True
>> >
>> > 'Open the workbook
>> > Set wbk = xlApp.Workbooks.Open(Filename:=MyFilename,
>> > ReadOnly:=False)
>> >
>> > 'Loop through all of the numbered sheets
>> > DoCmd.Hourglass True
>> > For intSheetNum = 4 To wbk.Sheets.Count
>> >
>> > DoEvents
>> >
>> > Set sht = wbk.Sheets(intSheetNum)
>> > sht.Activate
>> > strShtName = sht.Name
>> >
>> > 'If sheet has data, reformat the header row,
>> > 'change the worksheet name, import the worksheet
>> > 'then change the worksheet name back
>> > If intRowPointer > 1 Then
>> >
>> > 'Change the column names to correspond with those in
>> > 'tbl_Temp_Lit_Review
>> > sht.Cells(1, 1) = "Task"
>> > sht.Cells(1, 1).Hyperlinks.Delete
>> > sht.Cells(1, 2) = "Sub_Task"
>> > sht.Cells(1, 3) = "Source"
>> > sht.Cells(1, 4) = "Pg_Para"
>> > sht.Cells(1, 5) = "Classification"
>> > sht.Cells(1, 6) = "Potential_Gap"
>> > sht.Cells(1, 7) = "D"
>> > sht.Cells(1, 8) = "O"
>> > sht.Cells(1, 9) = "T"
>> > sht.Cells(1, 10) = "M"
>> > sht.Cells(1, 11) = "L"
>> > sht.Cells(1, 12) = "P"
>> > sht.Cells(1, 13) = "F"
>> > sht.Cells(1, 14) = "P2"
>> > sht.Cells(1, 15) = "Reviewer"
>> >
>> > 'Remove header row formatting
>> > Set rng = Range("A1:O1")
>> > rng.Select
>> > Selection.Borders(xlDiagonalDown).LineStyle = xlNone
>> > Selection.Borders(xlDiagonalUp).LineStyle = xlNone
>> > Selection.Borders(xlEdgeLeft).LineStyle = xlNone
>> > Selection.Borders(xlEdgeTop).LineStyle = xlNone
>> > Selection.Borders(xlEdgeBottom).LineStyle = xlNone
>> > Selection.Borders(xlEdgeRight).LineStyle = xlNone
>> > Selection.Borders(xlInsideVertical).LineStyle = xlNone
>> > Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
>> > Set rng = Nothing
>> >
>> > 'Worksheets are name 1.2.1, 1.3.1, ....
>> > 'Could not get method to work with periods in worksheet
>> > names
>> > 'so changed each sheets name, saved it, imported it, then
>> > 'changed it back
>> > sht.Name = "ImportThis"
>> > wbk.Save
>> > strImportRange = "ImportThis!A1:O" & intRowPointer
>> > DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9,
>> > _
>> > "tbl_Temp_Lit_Review", Filename,
>> > True,
>> > strImportRange
>> > sht.Name = strShtName
>> >
>> > End If
>> > Next
>> >
>> > wbk.Save
>> > wbk.Close
>> > xlApp.Quit
>> >
>> > End sub
>> >
>> > --
>> >
>> > email address is invalid
>> > Please reply to newsgroup only.
>> >

>>
>>


 
Reply With Quote
 
Dale Fye
Guest
Posts: n/a
 
      18th Apr 2008
Reading data one cell at a time from Excel is tedious, and slow.

It may have something to do with the fact that I am using
TransferSpreadsheet while the workbook is still open. I'll take a look at
that.

Thanks.
--
Don''t forget to rate the post if it was helpful!

email address is invalid
Please reply to newsgroup only.



"Norman Yuan" wrote:

> I guess it is because you use "DoCmd.TransferSpreadsheet()", which
> internally holds reference(s) to object(s) in Excel model.
>
> You could verify it by commentting out the line of code. Since you have
> already automated Excel and loop through worksheet/ranges/cells, why do you
> need to use DoCmd.TransferSpreadsheet()? Since you already opened Worksheet
> and have all data in the sheet in hand, and you are in Access, why not put
> the data directly into the table with DAO?
>
> If you have to use DoCmd.TransferSpreadsheet(), you could try to automate
> Excel and manipulate sheet/range/cell first, then save the sheet and close
> Excel; after that you call DoCmd.TransferSpreadsheet(). Not sure if it
> works, but worth trying.
>
>
> "Dale Fye" <(E-Mail Removed)> wrote in message
> news:1E69EBFE-A3BC-41AA-89A1-(E-Mail Removed)...
> > Norman,
> >
> > Thanks for the suggestion. I tried it, but that doesn't seem to do it
> > either. I even explicitly set the rng, sht, and wbk objects to Nothing
> > before exiting the subroutine, but Excel is still not being released. New
> > code looks like:
> >
> > Public Sub ExcelLitReviewImport(Filename)
> >
> > Dim xlApp As Object
> >
> > On Error GoTo ExcelLitReviewImportError
> >
> > 'Open Excel
> > Set xlApp = CreateObject("Excel.Application")
> > xlApp.Visible = True
> >
> > 'Call the details routine
> > Call ExcelLitReviewImportDetails(xlApp, Filename)
> >
> > ExcelLitReviewImportExit:
> > xlApp.Quit
> > Set xlApp = Nothing
> >
> > DoCmd.Hourglass False
> > Exit Sub
> >
> > ExcelLitReviewImportError:
> > If Err.Number = 3022 Then Resume Next
> > MsgBox Err.Number & vbCrLf & Err.Description, vbInformation + vbOKOnly,
> > "Error:ExcelLitReviewImport"
> > Debug.Print "ExcelLitReviewImport", Err.Number, Err.Description
> > Resume ExcelLitReviewImportExit
> >
> > End Sub
> > _____________________
> > Public Sub ExcelLitReviewImportDetails(xlApp As Object, Filename)
> >
> > Dim wbk As Object
> > Dim sht As Object
> > Dim rng As Object
> >
> > Dim intSheetNum As Integer, strShtName As String, intRowPointer As
> > Integer
> > Dim strImportRange As String
> > Dim frm As Form
> >
> > On Error GoTo ExcelLitReviewImportDetailsError
> >
> > Set frm = Forms("frm_Import_Lit_Review")
> > CurrentDb.Execute "DELETE * FROM tbl_Temp_Lit_Review", dbFailOnError
> >
> > 'Open the workbook
> > Set wbk = xlApp.Workbooks.Open(Filename:=Filename, ReadOnly:=False)
> >
> > 'Loop through all of the numbered sheets
> > DoCmd.Hourglass True
> > For intSheetNum = 4 To wbk.Sheets.Count
> >
> > Set sht = wbk.Sheets(intSheetNum)
> > sht.Activate
> > strShtName = sht.Name
> > frm.lbl_Routine.Caption = "Importing data from worksheet '" _
> > & strShtName & "'"
> > DoEvents
> >
> > 'Fill in the sub-task number for all rows with data
> > intRowPointer = 1
> > While sht.Cells(intRowPointer + 1, 3) <> ""
> > intRowPointer = intRowPointer + 1
> > sht.Cells(intRowPointer, 2) = strShtName
> > Wend
> >
> > 'If sheet has data:
> > ' reformat the header row,
> > ' change the worksheet name,
> > ' import the worksheet
> > ' then change the worksheet name back
> > If intRowPointer > 1 Then
> >
> > 'Change the column names to correspond with those in
> > 'tbl_Temp_Lit_Review
> > sht.Cells(1, 1) = "Task"
> > sht.Cells(1, 1).Hyperlinks.Delete
> > sht.Cells(1, 2) = "Sub_Task"
> > sht.Cells(1, 3) = "Source"
> > sht.Cells(1, 4) = "Pg_Para"
> > sht.Cells(1, 5) = "Classification"
> > sht.Cells(1, 6) = "Potential_Gap"
> > sht.Cells(1, 7) = "D"
> > sht.Cells(1, 8) = "O"
> > sht.Cells(1, 9) = "T"
> > sht.Cells(1, 10) = "M"
> > sht.Cells(1, 11) = "L"
> > sht.Cells(1, 12) = "P"
> > sht.Cells(1, 13) = "F"
> > sht.Cells(1, 14) = "P2"
> > sht.Cells(1, 15) = "Reviewer"
> >
> > 'Remove header row formatting
> > Set rng = sht.Range("A1:O1")
> > rng.Select
> > xlApp.Selection.Borders(5).LineStyle = -4142
> > xlApp.Selection.Borders(6).LineStyle = -4142
> > xlApp.Selection.Borders(7).LineStyle = -4142
> > xlApp.Selection.Borders(8).LineStyle = -4142
> > xlApp.Selection.Borders(9).LineStyle = -4142
> > xlApp.Selection.Borders(10).LineStyle = -4142
> > xlApp.Selection.Borders(11).LineStyle = -4142
> > xlApp.Selection.Borders(12).LineStyle = -4142
> > Set rng = Nothing
> >
> > sht.Name = "ImportThis"
> > wbk.Save
> > strImportRange = "ImportThis!A1:O" & intRowPointer
> > DoCmd.TransferSpreadsheet acImport, _
> >
> > acSpreadsheetTypeExcel9, _
> >
> > "tbl_Temp_Lit_Review", _
> > Filename, _
> > True, strImportRange
> > sht.Name = strShtName
> >
> > End If
> > Next
> >
> > ExcelLitReviewImportDetailsExit:
> > wbk.Save
> > Set rng = Nothing
> > Set sht = Nothing
> > wbk.Close
> > Set wbk = Nothing
> >
> > Exit Sub
> >
> > ExcelLitReviewImportDetailsError:
> > If Err.Number = 3022 Then Resume Next
> > MsgBox Err.Number & vbCrLf & Err.Description, _
> > vbInformation + vbOKOnly, _
> > "Error:ExcelLitReviewDetailsImport"
> > Debug.Print "ExcelLitReviewDetailsImport", Err.Number, Err.Description
> > Resume ExcelLitReviewImportDetailsExit
> >
> > End Sub
> >
> >
> > Dale
> >
> > --
> >
> > email address is invalid
> > Please reply to newsgroup only.
> >
> >
> >
> > "Norman Yuan" wrote:
> >
> >> The most poosible reason for Excel being left behind, even Quit() is
> >> called,
> >> is because in the current code executing scope there is still variable
> >> referring to objet(s) in Excel object model.
> >>
> >> In you case, they are "wbk", "sht" and "rng" variables. at the point when
> >> you call xlApp.Quit(), these 3 variables are still in scope and refers
> >> tothen Workbook, the last Worksheet and the last Range they were assigned
> >> to. They only go out of scope at the end of the Sub, after the Quit()
> >> call.
> >>
> >> So, you need to explicitly set them (or any variable in scope that points
> >> to
> >> an object in Excel object model) to Nothing before calling xlApp.Quit().
> >>
> >> This structure of code makes thing easier and clearer:
> >>
> >> Public Sub DoExcelAutomation(fileName As String)
> >>
> >> Dim xlApp As Excel.Application
> >>
> >> Set xlApp = CreateObject("Excel.Application")
> >> xlApp.Visible = True
> >>
> >> 'All variables referring to objects in Excel object model is
> >> 'local to DoProcess() method and will go out of scope
> >> 'without need to be set to Nothing explicitly
> >>
> >> DoProcess xlApp,fileName
> >>
> >> xlApp.Quit
> >>
> >> End
> >>
> >> Private Sub DoProcess(xlApp As Excel.Application, fileName As String)
> >>
> >> Dim wbk As Workbook
> >> Dim sht As Worksheet
> >> Dim rng As Range
> >>
> >> ''Do whatever
> >>
> >> ''Following code is not necessary
> >> 'Set wbk=Nothing
> >> 'Set sht=Nothing
> >> 'Set rng=Nothing
> >>
> >> End
> >>
> >>
> >> "Dale Fye" <(E-Mail Removed)> wrote in message
> >> news:7FCA9EB1-1071-40FB-8A83-(E-Mail Removed)...
> >> > I've seen other posts and have been working through them to resolve my
> >> > problem. The following code (I've cut some of the fluff) works to loop
> >> > through sheets of an Excel workbook and import the data into an Access
> >> > database. But will not release Excel. Any help would be greatly
> >> > appreciated.
> >> >
> >> > Public Sub ExcelLitReviewImport(MyFilename)
> >> >
> >> > Dim xlApp As Excel.Application
> >> > Dim wbk As Excel.Workbook
> >> > Dim sht As Excel.Worksheet
> >> > Dim rng As Excel.Range
> >> >
> >> > Dim intSheetNum As Integer, strShtName As String, intRowPointer As
> >> > Integer
> >> > Dim strImportRange As String
> >> > Dim qdf As DAO.QueryDef
> >> > Dim frm As Form
> >> >
> >> > On Error GoTo ExcelLitReviewImportError
> >> >
> >> > Set frm = Forms("frm_Import_Lit_Review")
> >> > CurrentDb.Execute "DELETE * FROM tbl_Temp_Lit_Review", dbFailOnError
> >> >
> >> > 'Open Excel and open the workbook to be imported,
> >> > frm.lbl_Routine.Visible = True
> >> > frm.lbl_Routine.Caption = "Updating Excel file column headers"
> >> > DoEvents
> >> > Set xlApp = CreateObject("Excel.Application")
> >> > xlApp.Visible = True
> >> >
> >> > 'Open the workbook
> >> > Set wbk = xlApp.Workbooks.Open(Filename:=MyFilename,
> >> > ReadOnly:=False)
> >> >
> >> > 'Loop through all of the numbered sheets
> >> > DoCmd.Hourglass True
> >> > For intSheetNum = 4 To wbk.Sheets.Count
> >> >
> >> > DoEvents
> >> >
> >> > Set sht = wbk.Sheets(intSheetNum)
> >> > sht.Activate
> >> > strShtName = sht.Name
> >> >
> >> > 'If sheet has data, reformat the header row,
> >> > 'change the worksheet name, import the worksheet
> >> > 'then change the worksheet name back
> >> > If intRowPointer > 1 Then
> >> >
> >> > 'Change the column names to correspond with those in
> >> > 'tbl_Temp_Lit_Review
> >> > sht.Cells(1, 1) = "Task"
> >> > sht.Cells(1, 1).Hyperlinks.Delete
> >> > sht.Cells(1, 2) = "Sub_Task"
> >> > sht.Cells(1, 3) = "Source"
> >> > sht.Cells(1, 4) = "Pg_Para"
> >> > sht.Cells(1, 5) = "Classification"
> >> > sht.Cells(1, 6) = "Potential_Gap"
> >> > sht.Cells(1, 7) = "D"
> >> > sht.Cells(1, 8) = "O"
> >> > sht.Cells(1, 9) = "T"
> >> > sht.Cells(1, 10) = "M"
> >> > sht.Cells(1, 11) = "L"
> >> > sht.Cells(1, 12) = "P"
> >> > sht.Cells(1, 13) = "F"
> >> > sht.Cells(1, 14) = "P2"
> >> > sht.Cells(1, 15) = "Reviewer"
> >> >
> >> > 'Remove header row formatting
> >> > Set rng = Range("A1:O1")
> >> > rng.Select
> >> > Selection.Borders(xlDiagonalDown).LineStyle = xlNone

 
Reply With Quote
 
Dale Fye
Guest
Posts: n/a
 
      21st Apr 2008
Norman,

I added a couple lines of code:

1. one before the transferspreadsheet that closes the workbook
2. one after the transfrerspreadsheet that reopens it

That resolved the problem.

Thanks for your self.

Dale
--
Don''t forget to rate the post if it was helpful!

email address is invalid
Please reply to newsgroup only.



"Norman Yuan" wrote:

> I guess it is because you use "DoCmd.TransferSpreadsheet()", which
> internally holds reference(s) to object(s) in Excel model.
>
> You could verify it by commentting out the line of code. Since you have
> already automated Excel and loop through worksheet/ranges/cells, why do you
> need to use DoCmd.TransferSpreadsheet()? Since you already opened Worksheet
> and have all data in the sheet in hand, and you are in Access, why not put
> the data directly into the table with DAO?
>
> If you have to use DoCmd.TransferSpreadsheet(), you could try to automate
> Excel and manipulate sheet/range/cell first, then save the sheet and close
> Excel; after that you call DoCmd.TransferSpreadsheet(). Not sure if it
> works, but worth trying.
>
>
> "Dale Fye" <(E-Mail Removed)> wrote in message
> news:1E69EBFE-A3BC-41AA-89A1-(E-Mail Removed)...
> > Norman,
> >
> > Thanks for the suggestion. I tried it, but that doesn't seem to do it
> > either. I even explicitly set the rng, sht, and wbk objects to Nothing
> > before exiting the subroutine, but Excel is still not being released. New
> > code looks like:
> >
> > Public Sub ExcelLitReviewImport(Filename)
> >
> > Dim xlApp As Object
> >
> > On Error GoTo ExcelLitReviewImportError
> >
> > 'Open Excel
> > Set xlApp = CreateObject("Excel.Application")
> > xlApp.Visible = True
> >
> > 'Call the details routine
> > Call ExcelLitReviewImportDetails(xlApp, Filename)
> >
> > ExcelLitReviewImportExit:
> > xlApp.Quit
> > Set xlApp = Nothing
> >
> > DoCmd.Hourglass False
> > Exit Sub
> >
> > ExcelLitReviewImportError:
> > If Err.Number = 3022 Then Resume Next
> > MsgBox Err.Number & vbCrLf & Err.Description, vbInformation + vbOKOnly,
> > "Error:ExcelLitReviewImport"
> > Debug.Print "ExcelLitReviewImport", Err.Number, Err.Description
> > Resume ExcelLitReviewImportExit
> >
> > End Sub
> > _____________________
> > Public Sub ExcelLitReviewImportDetails(xlApp As Object, Filename)
> >
> > Dim wbk As Object
> > Dim sht As Object
> > Dim rng As Object
> >
> > Dim intSheetNum As Integer, strShtName As String, intRowPointer As
> > Integer
> > Dim strImportRange As String
> > Dim frm As Form
> >
> > On Error GoTo ExcelLitReviewImportDetailsError
> >
> > Set frm = Forms("frm_Import_Lit_Review")
> > CurrentDb.Execute "DELETE * FROM tbl_Temp_Lit_Review", dbFailOnError
> >
> > 'Open the workbook
> > Set wbk = xlApp.Workbooks.Open(Filename:=Filename, ReadOnly:=False)
> >
> > 'Loop through all of the numbered sheets
> > DoCmd.Hourglass True
> > For intSheetNum = 4 To wbk.Sheets.Count
> >
> > Set sht = wbk.Sheets(intSheetNum)
> > sht.Activate
> > strShtName = sht.Name
> > frm.lbl_Routine.Caption = "Importing data from worksheet '" _
> > & strShtName & "'"
> > DoEvents
> >
> > 'Fill in the sub-task number for all rows with data
> > intRowPointer = 1
> > While sht.Cells(intRowPointer + 1, 3) <> ""
> > intRowPointer = intRowPointer + 1
> > sht.Cells(intRowPointer, 2) = strShtName
> > Wend
> >
> > 'If sheet has data:
> > ' reformat the header row,
> > ' change the worksheet name,
> > ' import the worksheet
> > ' then change the worksheet name back
> > If intRowPointer > 1 Then
> >
> > 'Change the column names to correspond with those in
> > 'tbl_Temp_Lit_Review
> > sht.Cells(1, 1) = "Task"
> > sht.Cells(1, 1).Hyperlinks.Delete
> > sht.Cells(1, 2) = "Sub_Task"
> > sht.Cells(1, 3) = "Source"
> > sht.Cells(1, 4) = "Pg_Para"
> > sht.Cells(1, 5) = "Classification"
> > sht.Cells(1, 6) = "Potential_Gap"
> > sht.Cells(1, 7) = "D"
> > sht.Cells(1, 8) = "O"
> > sht.Cells(1, 9) = "T"
> > sht.Cells(1, 10) = "M"
> > sht.Cells(1, 11) = "L"
> > sht.Cells(1, 12) = "P"
> > sht.Cells(1, 13) = "F"
> > sht.Cells(1, 14) = "P2"
> > sht.Cells(1, 15) = "Reviewer"
> >
> > 'Remove header row formatting
> > Set rng = sht.Range("A1:O1")
> > rng.Select
> > xlApp.Selection.Borders(5).LineStyle = -4142
> > xlApp.Selection.Borders(6).LineStyle = -4142
> > xlApp.Selection.Borders(7).LineStyle = -4142
> > xlApp.Selection.Borders(8).LineStyle = -4142
> > xlApp.Selection.Borders(9).LineStyle = -4142
> > xlApp.Selection.Borders(10).LineStyle = -4142
> > xlApp.Selection.Borders(11).LineStyle = -4142
> > xlApp.Selection.Borders(12).LineStyle = -4142
> > Set rng = Nothing
> >
> > sht.Name = "ImportThis"
> > wbk.Save
> > strImportRange = "ImportThis!A1:O" & intRowPointer
> > DoCmd.TransferSpreadsheet acImport, _
> >
> > acSpreadsheetTypeExcel9, _
> >
> > "tbl_Temp_Lit_Review", _
> > Filename, _
> > True, strImportRange
> > sht.Name = strShtName
> >
> > End If
> > Next
> >
> > ExcelLitReviewImportDetailsExit:
> > wbk.Save
> > Set rng = Nothing
> > Set sht = Nothing
> > wbk.Close
> > Set wbk = Nothing
> >
> > Exit Sub
> >
> > ExcelLitReviewImportDetailsError:
> > If Err.Number = 3022 Then Resume Next
> > MsgBox Err.Number & vbCrLf & Err.Description, _
> > vbInformation + vbOKOnly, _
> > "Error:ExcelLitReviewDetailsImport"
> > Debug.Print "ExcelLitReviewDetailsImport", Err.Number, Err.Description
> > Resume ExcelLitReviewImportDetailsExit
> >
> > End Sub
> >
> >
> > Dale
> >
> > --
> >
> > email address is invalid
> > Please reply to newsgroup only.
> >
> >
> >
> > "Norman Yuan" wrote:
> >
> >> The most poosible reason for Excel being left behind, even Quit() is
> >> called,
> >> is because in the current code executing scope there is still variable
> >> referring to objet(s) in Excel object model.
> >>
> >> In you case, they are "wbk", "sht" and "rng" variables. at the point when
> >> you call xlApp.Quit(), these 3 variables are still in scope and refers
> >> tothen Workbook, the last Worksheet and the last Range they were assigned
> >> to. They only go out of scope at the end of the Sub, after the Quit()
> >> call.
> >>
> >> So, you need to explicitly set them (or any variable in scope that points
> >> to
> >> an object in Excel object model) to Nothing before calling xlApp.Quit().
> >>
> >> This structure of code makes thing easier and clearer:
> >>
> >> Public Sub DoExcelAutomation(fileName As String)
> >>
> >> Dim xlApp As Excel.Application
> >>
> >> Set xlApp = CreateObject("Excel.Application")
> >> xlApp.Visible = True
> >>
> >> 'All variables referring to objects in Excel object model is
> >> 'local to DoProcess() method and will go out of scope
> >> 'without need to be set to Nothing explicitly
> >>
> >> DoProcess xlApp,fileName
> >>
> >> xlApp.Quit
> >>
> >> End
> >>
> >> Private Sub DoProcess(xlApp As Excel.Application, fileName As String)
> >>
> >> Dim wbk As Workbook
> >> Dim sht As Worksheet
> >> Dim rng As Range
> >>
> >> ''Do whatever
> >>
> >> ''Following code is not necessary
> >> 'Set wbk=Nothing
> >> 'Set sht=Nothing
> >> 'Set rng=Nothing
> >>
> >> End
> >>
> >>
> >> "Dale Fye" <(E-Mail Removed)> wrote in message
> >> news:7FCA9EB1-1071-40FB-8A83-(E-Mail Removed)...
> >> > I've seen other posts and have been working through them to resolve my
> >> > problem. The following code (I've cut some of the fluff) works to loop
> >> > through sheets of an Excel workbook and import the data into an Access
> >> > database. But will not release Excel. Any help would be greatly
> >> > appreciated.
> >> >
> >> > Public Sub ExcelLitReviewImport(MyFilename)
> >> >
> >> > Dim xlApp As Excel.Application
> >> > Dim wbk As Excel.Workbook
> >> > Dim sht As Excel.Worksheet
> >> > Dim rng As Excel.Range
> >> >
> >> > Dim intSheetNum As Integer, strShtName As String, intRowPointer As
> >> > Integer
> >> > Dim strImportRange As String
> >> > Dim qdf As DAO.QueryDef
> >> > Dim frm As Form
> >> >
> >> > On Error GoTo ExcelLitReviewImportError
> >> >
> >> > Set frm = Forms("frm_Import_Lit_Review")
> >> > CurrentDb.Execute "DELETE * FROM tbl_Temp_Lit_Review", dbFailOnError
> >> >
> >> > 'Open Excel and open the workbook to be imported,
> >> > frm.lbl_Routine.Visible = True
> >> > frm.lbl_Routine.Caption = "Updating Excel file column headers"
> >> > DoEvents
> >> > Set xlApp = CreateObject("Excel.Application")
> >> > xlApp.Visible = True
> >> >
> >> > 'Open the workbook
> >> > Set wbk = xlApp.Workbooks.Open(Filename:=MyFilename,
> >> > ReadOnly:=False)
> >> >
> >> > 'Loop through all of the numbered sheets
> >> > DoCmd.Hourglass True
> >> > For intSheetNum = 4 To wbk.Sheets.Count
> >> >
> >> > DoEvents
> >> >
> >> > Set sht = wbk.Sheets(intSheetNum)
> >> > sht.Activate
> >> > strShtName = sht.Name
> >> >
> >> > 'If sheet has data, reformat the header row,
> >> > 'change the worksheet name, import the worksheet
> >> > 'then change the worksheet name back
> >> > If intRowPointer > 1 Then
> >> >
> >> > 'Change the column names to correspond with those in
> >> > 'tbl_Temp_Lit_Review
> >> > sht.Cells(1, 1) = "Task"
> >> > sht.Cells(1, 1).Hyperlinks.Delete
> >> > sht.Cells(1, 2) = "Sub_Task"
> >> > sht.Cells(1, 3) = "Source"
> >> > sht.Cells(1, 4) = "Pg_Para"
> >> > sht.Cells(1, 5) = "Classification"
> >> > sht.Cells(1, 6) = "Potential_Gap"
> >> > sht.Cells(1, 7) = "D"
> >> > sht.Cells(1, 8) = "O"
> >> > sht.Cells(1, 9) = "T"
> >> > sht.Cells(1, 10) = "M"
> >> > sht.Cells(1, 11) = "L"
> >> > sht.Cells(1, 12) = "P"
> >> > sht.Cells(1, 13) = "F"
> >> > sht.Cells(1, 14) = "P2"
> >> > sht.Cells(1, 15) = "Reviewer"
> >> >
> >> > 'Remove header row formatting
> >> > Set rng = Range("A1:O1")
> >> > rng.Select
> >> > Selection.Borders(xlDiagonalDown).LineStyle = xlNone

 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Excel Automation from Access - releasing instance Gary Cobden Microsoft Access 5 21st Dec 2004 09:34 AM
Releasing Excel Instance - Automation from Access =?Utf-8?B?R2FyeQ==?= Microsoft Access VBA Modules 1 20th Dec 2004 09:45 AM
Excel Automation from Access - releasing instance Gary Cobden Microsoft Access 0 19th Dec 2004 10:33 PM
Releasing Excel Automation Gary Cobden Microsoft Access External Data 2 13th Dec 2004 08:03 PM
Releasing Excel Automation Gary Cobden Microsoft Access 1 13th Dec 2004 03:30 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 07:08 PM.