Excel Instance wont close form Access VBA

Ruzz2k

Registered User.
Local time
Today, 14:35
Joined
Apr 28, 2012
Messages
102
Hi my code does exactly what I want it to do except I cannot get the excel instance to close, I know its my coding but I have no clue where I am going wrong.

please could someone help me, many thanks in advance

my code does the following, user selects excel file, opens it, renames sheets, basically needs first sheet to be sheet1. rest don't matter
Changes the formats in column a to number and 15dp, saves the file as .xls and then links the file to the database.

Code:
Private Sub Command288_Click()
Dim s As String
Dim i As Long
Dim ExcelWorkbook As Excel.Workbook
s = LaunchCD(Me)
    
    Dim XLApp As Object
    Set XLApp = CreateObject("Excel.Application")
    XLApp.Visible = False
    Set ExcelWorkbook = XLApp.Workbooks.Open(s)
    
    With ExcelWorkbook
For i = 1 To ExcelWorkbook.Sheets.Count
ExcelWorkbook.Sheets(i).Name = "Sheet" & i & ""
Next
End With
ExcelWorkbook.Sheets(1).Columns("A:A").Select
Selection.NumberFormat = "0.000000000000000"
ExcelWorkbook.SaveAs Left(s, InStrRev(s, ".") - 1) & ".xls", FileFormat:=xlNormal
    ExcelWorkbook.Close
    Set ExcelWorkbook = Nothing
    XLApp.Quit
    Set XLApp = Nothing
    
    
DoCmd.TransferSpreadsheet acLink, , "Sheet1", Left(s, InStrRev(s, ".") - 1) & ".xls", True, "Sheet1!A14:C43"
DoCmd.OpenForm ("frmList1")
Forms![frmList1]![Text0] = Left(s, InStrRev(s, ".") - 1) & ".xls"
 
this is suspect:
Selection.NumberFormat = "0.000000000000000"

since it does not refer to the specific object
 
thanks spikepl sorted all works now. been struggling for days
 
How did you get it to close? I am having the same issue and I have the code that should work.

xWb.Close
xApp.Quit

I have even tried:
xWb.Close True
xApp.Quit

I am using access 2010
 
Bilbo Baggins Esq ~ I have read your post but can not find where I am leaving it open\orphaned. If I post my code will you look at it?
 
of course

What you're looking for is NOT where you try to quit.

You ARE looking for the Excel methods used on the Excel Object.
 
Okay, i guess I am not grasping that concept. I will post my code. It is long.
 
Code:
[COLOR="SeaGreen"]'Declare variables[/COLOR]
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim xApp As Excel.Application
Dim xWb As Excel.Workbook
Dim xWs As Excel.Worksheet
Dim strFile As String
Dim varRows As Variant
Dim varLoop As Variant
Dim varRow1 As Variant
Dim strTable As String


[COLOR="seagreen"]'Location of where the file is stored[/COLOR]
strFile = "C:\MKPHA.xlsx"

strTable = "tblScripts"

[COLOR="seagreen"]'Open a new excel workbook and Save it.[/COLOR]
Set xApp = New Excel.Application
Set xWb = xApp.Workbooks.Add
xWb.SaveAs (strFile)
Set xWs = xWb.Worksheets("Sheet1")
xWs.Activate

[COLOR="seagreen"]'Import the txt file into excel[/COLOR]
With ActiveSheet.QueryTables.Add(Connection:= _
       "TEXT;C:\MK PHA.txt", Destination:=Range("$A$1") _
        )
        .Name = "MK PHA"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 9
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 1)
        .TextFileFixedColumnWidths = Array(19, 45)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
End With

[COLOR="seagreen"]'Count how many rows are in the sheet for later use with
'Do until command for correcting the spreadsheet so it can be inported[/COLOR]varRows = xWs.UsedRange.Rows.Count
varLoop = 248
varRow1 = 8 + 248

[COLOR="seagreen"]'Deleting all unwanted data from the spreadsheet.[/COLOR]
With xWs
    Do Until varLoop > varRows
        .Rows(varLoop & ":" & varRow1).Select
            With Selection
                .Delete Shift:=xlUp
            End With
        varLoop = varLoop + 247
        varRow1 = varLoop + 8
        varRows = xWs.UsedRange.Rows.Count
    Loop
        
End With

[COLOR="seagreen"]'setting the database and recordset[/COLOR]
Set db = CurrentDb()
Set rs = db.OpenRecordset(strTable)

[COLOR="seagreen"]'finding the max number of records to import[/COLOR]
varRows = xWs.UsedRange.Rows.Count

[COLOR="seagreen"]'Declaring more Variables for the progress bar[/COLOR]
Dim MaxRecords, Blocks, Counter, MinBlock, Percent As Integer

[COLOR="seagreen"]'Setting default variables for the progress bar calculator[/COLOR]
Counter = 0
Percent = 1
varLoop = 1

[COLOR="seagreen"]'Setting variables and setting up calculations[/COLOR]
MaxRecords = varRows '
Blocks = Int(MaxRecords / 10)
MinBlock = Blocks

[COLOR="seagreen"]'Setting the for as variable/object[/COLOR]
Dim form_progress As Form_frmImportExcel
Set form_progress = Form_frmImportExcel

[COLOR="seagreen"]'Making the lines around the progress bar visible[/COLOR]
form_progress.lbl0.Visible = True
form_progress.Line12.Visible = True
form_progress.Line13.Visible = True
form_progress.Line14.Visible = True
form_progress.Line15.Visible = True

form_progress.lblMessage.Caption = "Started Downloading..... 0% Complete"

[COLOR="seagreen"]'importing the data to Access[/COLOR]
With rs
   Do Until varLoop > varRows
        .AddNew
        rs!ScriptNo = xWs.Cells(varLoop, 1)
        rs!ScriptDesc = xWs.Cells(varLoop, 2)
        rs!ScriptAmount = xWs.Cells(varLoop, 3)
        .Update
        varLoop = varLoop + 1
            Counter = Counter + 1
      If (Counter = Blocks) Then
            If (Percent = 1) Then
                form_progress.lbl10.Visible = True
                form_progress.lblMessage.Caption = "10% Complete"
            ElseIf (Percent = 2) Then
                form_progress.lbl20.Visible = True
                form_progress.lblMessage.Caption = "20% Complete"
            ElseIf (Percent = 3) Then
                form_progress.lbl30.Visible = True
                form_progress.lblMessage.Caption = "30% Complete"
            ElseIf (Percent = 4) Then
                form_progress.lbl40.Visible = True
                form_progress.lblMessage.Caption = "40% Complete"
            ElseIf (Percent = 5) Then
                form_progress.lbl50.Visible = True
                form_progress.lblMessage.Caption = "50% Complete"
            ElseIf (Percent = 6) Then
                form_progress.lbl60.Visible = True
                form_progress.lblMessage.Caption = "60% Complete"
            ElseIf (Percent = 7) Then
                form_progress.lbl70.Visible = True
                form_progress.lblMessage.Caption = "70% Complete"
            ElseIf (Percent = 8) Then
                form_progress.lbl80.Visible = True
                form_progress.lblMessage.Caption = "80% Complete"
            ElseIf (Percent = 9) Then
                form_progress.lbl90.Visible = True
                form_progress.lblMessage.Caption = "90% Complete"
            ElseIf (Percent = 10) Then
                form_progress.lbl100.Visible = True
                form_progress.lblMessage.Caption = "Download 100% Complete"
            End If
            Percent = Percent + 1
            Blocks = Blocks + MinBlock
      End If
      
   Loop
        .Close
End With



[COLOR="seagreen"]'quitting or closing connections and set objects to nothing.[/COLOR]
xWb.Close True
Set xWb = Nothing
Set xWs = Nothing
xApp.Quit
Set xApp = Nothing

Set rs = Nothing
Set db = Nothing


[COLOR="seagreen"]'Hiding the progress bar.[/COLOR]
form_progress.Line12.Visible = False
form_progress.Line13.Visible = False
form_progress.Line14.Visible = False
form_progress.Line15.Visible = False
form_progress.lbl0.Visible = False
form_progress.lbl10.Visible = False
form_progress.lbl20.Visible = False
form_progress.lbl30.Visible = False
form_progress.lbl40.Visible = False
form_progress.lbl50.Visible = False
form_progress.lbl60.Visible = False
form_progress.lbl70.Visible = False
form_progress.lbl80.Visible = False
form_progress.lbl90.Visible = False
form_progress.lbl100.Visible = False

Call Pause(3)

form_progress.lblMessage.Caption = " "
 
Last edited:
I think you'll need to look at:

ActiveSheet needs to be associated with xWb

In fact, I'm not even sure why you're using ActiveSheet since you've set xWs to be xWb.WorkSheets("Sheet1") and then activated it.

But whatever, it will assuredly need be associated with xWb
For example: xWb.ActiveSheet
Or perhaps even better would be xWs.QueryTables.Add...

Also, I generally make a habit of closing and setting to nothing, all my objects in the reverse order they were created.

in your case
xApp was created first
xWb was created second
xWs was created last

so
xWs gets closed and saved (you have this already)
But then then you set the xWb to nothing BEFORE you set xWs to nothing
I would do it in the opposite order.
 
Thank you very much for the pointers. I was just looking at the code and thinking the same thing about the activesheet.QueryTables.add. I git that from a macro created in excel. not the best practice.
 
I have narrowed it down to this but I cant figure out where the closing option should go, since Excel.EXE *32 is still in the task manager.


Code:
Set xApp = New Excel.Application
Set xWb = xApp.Workbooks.Open(strFile)
Set xWs = xWb.Worksheets("Sheet1")
xWs.Activate
xApp.Visible = True


[COLOR="SeaGreen"]'Import the txt file into excel[/COLOR]
With xWs.QueryTables.Add(Connection:= _
       "TEXT;C:\MK PHA.txt", Destination:=Range("$A$1"))
        .Name = "MK PHA"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 9
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 1)
        .TextFileFixedColumnWidths = Array(19, 45)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        xWb.Save
        xWb.Close (False)
        Set xWs = Nothing
        Set xWb = Nothing
        xApp.Quit
        Set xApp = Nothing
End With
 
On my way home, but you may need to close/delete that connection too.

Sent from my Nokia Lumia 1520
Running Windows Phone 8.1
 
Like this?

Code:
Set xApp = New Excel.Application
Set xWb = xApp.Workbooks.Open(strFile)
Set xWs = xWb.Worksheets("Sheet1")
xWs.Activate
xApp.Visible = True



[COLOR="SeaGreen"]'Import the txt file into excel[/COLOR]
With xWs.QueryTables.Add(Connection:= _
       "TEXT;C:\MK PHA.txt", Destination:=Range("$A$1"))
        .Name = "MK PHA"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 9
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 1)
        .TextFileFixedColumnWidths = Array(19, 45)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        xWb.Save
        xWb.Close (False)
        Set xWs = Nothing
        Set xWb = Nothing
        xApp.Quit
        Set xApp = Nothing
        
End With

Set xWs = Nothing
Set xWb = Nothing
Set xApp = Nothing

Tried this way and tried it with

Code:
Set xWs = Nothing
'xWb.Close (False)
Set xWb = Nothing
xApp.Quit
Set xApp = Nothing

And that throws an error:
Object Variable or With block variable not set.
I have never had this much difficulty with excel in the past. ugh, fustrastion. :banghead:

I do really appreciate you helping me and giving me points.
 
Last edited:
ok, the problem is the Range in the Connection String

Change:
Code:
With xWs.QueryTables.Add(Connection:="TEXT;C:\AWF\MK PHA.txt", _
        Destination:=Range("$A$1"))
To:
Code:
With xWs.QueryTables.Add(Connection:="TEXT;C:\AWF\MK PHA.txt", _
        Destination:=xWs.Range("$A$1"))
Also, after the With/End With, I would consider adding this line:
Code:
xWs.QueryTables.Item("MK PHA").Delete
And then your closing sequence:
Code:
xWb.Close True
Set xWs = Nothing
Set xWb = Nothing
xApp.Quit
Set xApp = Nothing
 
as a few aside notes:

This is really a funky way to get the job done (creating an Excel data connection to a text file from and for Access).

There are any number of better ways to get this done.

Recorded VBA can, from time to time get the job done, but as you have just seen first hand, it can be very problematic.

I would explore the possibility of opening it directly in Access as a recordset.
Perform what ever manipulation of you feel so inclined (if any) and then put it directly in your Access table
 
Bilbo_Baggins_Esq ~ you are a genius! thank you so much!
 
Bilbo_Baggins_Esq ~ I don't know how to manipulate the data via access. I need rows/lines deleted that are headers to the report.
 
Well I found another orphan after Bilbo_Baggins_Esq helped me. This is the code that was causing the issue:
Code:
With xWs
    Do Until varLoop > varRows
        .Rows(varLoop & ":" & varRow1).Select
            With Selection
                .Delete Shift:=xlUp
            End With
        varLoop = varLoop + 247
        varRow1 = varLoop + 8
        varRows = xWs.UsedRange.Rows.Count
    Loop
        
End With

Its doesn't like the with statement with Worksheet. Since I didn't know how to kill it, I rewrote it as Follows:
Code:
Do Until varLoop > varRows
    xApp.ActiveSheet.Rows(varLoop & ":" & varRow1).Select
    xApp.ActiveSheet.Rows(varLoop & ":" & varRow1).Delete Shift:=xlUp
        varLoop = varLoop + 247
        varRow1 = varLoop + 8
        varRows = varRows - 9
Loop

I hope this might help someone else that is having an issue with orphan excel programs. :banghead:
 
Hello there.

I'm having the same problem, and looked my code a thousand times looking where else I could reference but couldn't find it.

It's a simple code to paste to an excel sheet the contents of a query.

Please help me out!

Thanks!

Code:
Private Sub bot_Exportar_Click()
    
    Dim myQueryName As String
    Dim myExportFileName As String
    
    Dim xlApp As New Excel.Application
    Dim wb As Excel.Workbook
    
    myQueryName = "qry_Dados"
    myExportFileName = PATH_EXPORT & "Exemplo Relatório Sales Funnel.xlsx"
    Set wb = xlApp.Workbooks.Open(myExportFileName, True, False)
    wb.Sheets(1).Rows("1:" & Rows.Count).ClearContents
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, myQueryName, myExportFileName, False, "cpo_Import"
    
    wb.Close True
    xlApp.Quit
    
    Set wb = Nothing
    Set xlApp = Nothing
    
End Sub
 

Users who are viewing this thread

Back
Top Bottom