Why won't Excel process end!? ** RESOLVED **

[Armbruster]

I wrote a program to check if a SSN is valid based on high-group listings from the Social Security Administration. I am too lazy to create a needed database file from the info manually, so I created a program to download the information for me and create the file.

The problem is that Excel is still running as a process when the code execution stops. The Excel process doesn't stop until I close the program. What am I doing wrong!!

Option Explicit
 
Dim WordApp As Word.Application
Dim ExcelApp As Excel.Application
 
Private Sub Form_Load()
    lstStatus.Clear
    Inet1.Protocol = icHTTP
End Sub
Private Sub cmdGet_Click()
    ProcessFile
End Sub
Private Sub ProcessFile()
    cmdGet.Enabled = False
    DoEvents
    Dim strURL As String
    Dim bData() As Byte      ' Data variable
    Dim intFile As Integer   ' FreeFile variable
    strURL = "http://www.ssa.gov/foia/highgroupdownloads/HG0903.doc"
    intFile = FreeFile()
    
    ' The result of the OpenURL method goes into the Byte
    ' array, and the Byte array is then saved to disk.
    lstStatus.AddItem "Opening Social Security Website . . ."
    bData() = Inet1.OpenURL(strURL, icByteArray)
    lstStatus.AddItem "Downloading SSN document . . ."
    Open App.Path & "\ssn.doc" For Binary Access Write As #intFile
    Put #intFile, , bData()
    Close #intFile
    
    lstStatus.AddItem "Converting SSN document to text file . . ."
    Set WordApp = New Word.Application
    With WordApp
        .WindowState = wdWindowStateMinimize
        .Visible = False
        .DisplayAlerts = wdAlertsNone       'hide word alerts msgboxes
        .Documents.Open App.Path & "\SSN.doc"
        .ActiveDocument.SaveAs FileName:=App.Path & "\SSN.txt", _
            FileFormat:=wdFormatText, _
            LockComments:=False, _
            Password:="", _
            AddToRecentFiles:=False, _
            WritePassword:="", _
            ReadOnlyRecommended:=False, _
            EmbedTrueTypeFonts:=False, _
            SaveNativePictureFormat:=False, _
            SaveFormsData:=False, _
            SaveAsAOCELetter:=False
        .Documents.Close False
    End With
    WordApp.Application.Quit False
    Set WordApp = Nothing
    
    lstStatus.AddItem "Reading SSN text file into array . . ."
    Dim strData As String
    Dim intData(1000, 1) As Integer
    Dim i As Integer
 
    intFile = FreeFile()
    i = 0
 
    Open App.Path & "\SSN.txt" For Input As #intFile
    Do While Not EOF(intFile)
        'get group
        Input #intFile, strData
        intData(i, 0) = Val(strData)
        'exit loop if we run out of data but the file still
        '  has "stuff" in it
        If intData(i, 0) = 0 Then Exit Do
        'get area
        Input #intFile, strData
        intData(i, 1) = Val(strData)
        'increment counter
        i = i + 1
    Loop
    Close #intFile
    
    lstStatus.AddItem "Saving SSN text file as CSV file . . ."
    intFile = FreeFile()
 
    Open App.Path & "\SSN.txt" For Output As #intFile
    Dim j As Integer
    For j = 0 To i - 1
        Write #intFile, intData(j, 0), intData(j, 1)
    Next j
    Close #intFile
    
    lstStatus.AddItem "Reading SSN CSV file into Excel . . ."
    Set ExcelApp = New Excel.Application
    With ExcelApp
        .WindowState = xlMinimized
        .Visible = False
        'hide excel alerts msgboxes
        .DisplayAlerts = False
        .Workbooks.OpenText FileName:=App.Path & "\SSN.txt", _
            Origin:=xlWindows, _
            StartRow:=1, _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=False, _
            Semicolon:=False, _
            Comma:=True, _
            Space:=False, _
            Other:=False, _
            FieldInfo:=Array(Array(1, 1), Array(2, 1))
    lstStatus.AddItem "Creating new HG.dbf file . . ."
        .ActiveSheet.Range("A1:B1050").Select
        .Selection.Sort Key1:=Range("A1"), _
            Order1:=xlAscending, _
            Header:=xlGuess, _
            OrderCustom:=1, _
            MatchCase:=False, _
            Orientation:=xlTopToBottom
        .ActiveSheet.Range("A1").Select
        .Selection.EntireRow.Insert
        .ActiveCell.FormulaR1C1 = "Area"
        .ActiveSheet.Range("B1").Select
        .ActiveCell.FormulaR1C1 = "Group"
        .ActiveSheet.Range("A1").Select
        .ActiveWorkbook.SaveAs FileName:=App.Path & "\HG.dbf", _
            FileFormat:=xlDBF4, _
            CreateBackup:=False
        .ActiveWorkbook.Saved = True
        .ActiveWorkbook.Close
        .Workbooks.Close
    End With
    ExcelApp.Application.Quit
    Set ExcelApp = Nothing
    lstStatus.AddItem "Process complete"
End Sub

[Bruce Fox]

G'Day Armbruster,

I successfully tested the Excel portion of your code. (i made a.txt to test with).

Maybe it's getting held up somewhere.
What happens if you step thru the code; where does it hold up?

That is potentially supported by your comment that Excel runs til you quit your App. If you have posted your entire App there is no where else to .Quit Excel!

[Armbruster]

Hey Bruce,

How's it going? Good to hear from you again.

That is the entire application. I did step though it on my machine at home and my machine at work. The code runs completely with no errors or breaks. The .quit, .close and set ExcelApp = nothing all process fine.

I am stumped here!

[Bruce Fox]

Keeping busy and yourself?

What happens if you test with a staic TextFile, and comment out the Inet and Word code to test the Excel side of the house?


Bruce.

[Armbruster]

I ran it like this and had the same results . . . ???

Option Explicit
 
Dim WordApp As Word.Application
Dim ExcelApp As Excel.Application
 
Private Sub Form_Load()
    lstStatus.Clear
    Inet1.Protocol = icHTTP
End Sub
Private Sub cmdGet_Click()
    ProcessFile
End Sub
Private Sub ProcessFile()
    cmdGet.Enabled = False
    DoEvents
'    Dim strURL As String
'    Dim bData() As Byte      ' Data variable
'    Dim intFile As Integer   ' FreeFile variable
'    strURL = "http://www.ssa.gov/foia/highgroupdownloads/HG0903.doc"
'    intFile = FreeFile()
'
'    ' The result of the OpenURL method goes into the Byte
'    ' array, and the Byte array is then saved to disk.
'    lstStatus.AddItem "Opening Social Security Website . . ."
'    bData() = Inet1.OpenURL(strURL, icByteArray)
'    lstStatus.AddItem "Downloading SSN document . . ."
'    Open App.Path & "\ssn.doc" For Binary Access Write As #intFile
'    Put #intFile, , bData()
'    Close #intFile
'
'    lstStatus.AddItem "Converting SSN document to text file . . ."
'    Set WordApp = New Word.Application
'    With WordApp
'        .WindowState = wdWindowStateMinimize
'        .Visible = False
'        .DisplayAlerts = wdAlertsNone       'hide word alerts msgboxes
'        .Documents.Open App.Path & "\SSN.doc"
'        .ActiveDocument.SaveAs FileName:=App.Path & "\SSN.txt", _
'            FileFormat:=wdFormatText, _
'            LockComments:=False, _
'            Password:="", _
'            AddToRecentFiles:=False, _
'            WritePassword:="", _
'            ReadOnlyRecommended:=False, _
'            EmbedTrueTypeFonts:=False, _
'            SaveNativePictureFormat:=False, _
'            SaveFormsData:=False, _
'            SaveAsAOCELetter:=False
'        .Documents.Close False
'    End With
'    WordApp.Application.Quit False
'    Set WordApp = Nothing
'
'    lstStatus.AddItem "Reading SSN text file into array . . ."
'    Dim strData As String
'    Dim intData(1000, 1) As Integer
'    Dim i As Integer
'
'    intFile = FreeFile()
'    i = 0
'
'    Open App.Path & "\SSN.txt" For Input As #intFile
'    Do While Not EOF(intFile)
'        'get group
'        Input #intFile, strData
'        intData(i, 0) = Val(strData)
'        'exit loop if we run out of data but the file still
'        '  has "stuff" in it
'        If intData(i, 0) = 0 Then Exit Do
'        'get area
'        Input #intFile, strData
'        intData(i, 1) = Val(strData)
'        'increment counter
'        i = i + 1
'    Loop
'    Close #intFile
'
'    lstStatus.AddItem "Saving SSN text file as CSV file . . ."
'    intFile = FreeFile()
'
'    Open App.Path & "\SSN.txt" For Output As #intFile
'    Dim j As Integer
'    For j = 0 To i - 1
'        Write #intFile, intData(j, 0), intData(j, 1)
'    Next j
'    Close #intFile
    
    lstStatus.AddItem "Reading SSN CSV file into Excel . . ."
    Set ExcelApp = New Excel.Application
    With ExcelApp
        .WindowState = xlMinimized
        .Visible = False
        'hide excel alerts msgboxes
        .DisplayAlerts = False
        .Workbooks.OpenText FileName:=App.Path & "\SSN.txt", _
            Origin:=xlWindows, _
            StartRow:=1, _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=False, _
            Semicolon:=False, _
            Comma:=True, _
            Space:=False, _
            Other:=False, _
            FieldInfo:=Array(Array(1, 1), Array(2, 1))
    lstStatus.AddItem "Creating new HG.dbf file . . ."
        .ActiveSheet.Range("A1:B1050").Select
        .Selection.Sort Key1:=Range("A1"), _
            Order1:=xlAscending, _
            Header:=xlGuess, _
            OrderCustom:=1, _
            MatchCase:=False, _
            Orientation:=xlTopToBottom
        .ActiveSheet.Range("A1").Select
        .Selection.EntireRow.Insert
        .ActiveCell.FormulaR1C1 = "Area"
        .ActiveSheet.Range("B1").Select
        .ActiveCell.FormulaR1C1 = "Group"
        .ActiveSheet.Range("A1").Select
        .ActiveWorkbook.SaveAs FileName:=App.Path & "\HG.dbf", _
            FileFormat:=xlDBF4, _
            CreateBackup:=False
        .ActiveWorkbook.Saved = True
        .ActiveWorkbook.Close
        .Workbooks.Close
    End With
    ExcelApp.Application.Quit
    Set ExcelApp = Nothing
    lstStatus.AddItem "Process complete"
End Sub

Bruce, my wife and I were watching a special about Australia on Discovery. We decided we either want to visit or MOVE there! We kept wishing we had friends to stay with there. Don't be suprised if you see a family of 4 knocking on your door!! ha ha!

[Bruce Fox]

I re-tested with your latest post except for the Inet (I can't load Components on this machine) and replaced the File I/O with C:\.
My simple TextFile has Alpha characters on each line.

I'm running Win 2000, and made Reference to the MS Excel 9.0 Object Library.

Here is what I used:

Option Explicit
Dim ExcelApp As Excel.Application
 
Private Sub Command1_Click()
    Main
End Sub
 
Private Sub Main()
 
    lstStatus.AddItem "Reading SSN CSV file into Excel . . ."
    Set ExcelApp = New Excel.Application
    With ExcelApp
        .WindowState = xlMinimized
        .Visible = False
        'hide excel alerts msgboxes
        .DisplayAlerts = False
        .Workbooks.OpenText FileName:="[b]C:\[/b]SSN.txt", _
            Origin:=xlWindows, _
            StartRow:=1, _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=False, _
            Semicolon:=False, _
            Comma:=True, _
            Space:=False, _
            Other:=False, _
            FieldInfo:=Array(Array(1, 1), Array(2, 1))
    lstStatus.AddItem "Creating new HG.dbf file . . ."
        .ActiveSheet.Range("A1:B1050").Select
        .Selection.Sort Key1:=Range("A1"), _
            Order1:=xlAscending, _
            Header:=xlGuess, _
            OrderCustom:=1, _
            MatchCase:=False, _
            Orientation:=xlTopToBottom
        .ActiveSheet.Range("A1").Select
        .Selection.EntireRow.Insert
        .ActiveCell.FormulaR1C1 = "Area"
        .ActiveSheet.Range("B1").Select
        .ActiveCell.FormulaR1C1 = "Group"
        .ActiveSheet.Range("A1").Select
        .ActiveWorkbook.SaveAs FileName:="[b]C:\[/b]HG.dbf", _
            FileFormat:=xlDBF4, _
            CreateBackup:=False
        .ActiveWorkbook.Saved = True
        .ActiveWorkbook.Close
        .Workbooks.Close
    End With
    ExcelApp.Application.Quit
    Set ExcelApp = Nothing
    lstStatus.AddItem "Process complete"
End Sub

We have a spare room and plenty of space, just give us a few days notice
My wife is from NY and has been here for 8 years, she is now an honorary Aussie.



Bruce.

[binduau]

hmm,

it ran OK for me 3 times then the Excel process would not close.

If i might be so bold as to say that you are going at this from the wrong direction. what you should do is create a process or use the GetObject API as in the following code for WORD you can use the same technique for EXCEL. then when you close or quit or whatever the APP it really is Closed.........

If it hangs around in ram still then that is no biggy because that app version is used the next time the code runs, this saves it having to initialize itself again and thus saves time and processing power.

I know the excel code is a bit elaborate but you can see how to simplify it by looking at the word version....

Aside from that if you use the following code, you can use an
existing version of the APP...... if it did not or does not unload or is being used by someone on the Machine for another purpose.

'for word................... See below this for excel....

Public Sub OpenFileInWord(StrDocName)
 
' Note:
' You must have a reference to the Word Object Library.
 
 
Dim wd As Word.Application
 
On Error GoTo cmdOpenDocErr
'See if word is already open
    Set wd = GetObject(, "Word.Application")
'if not create a new instance
RestartOpen:
If wd Is Nothing Then
    Set wd = CreateObject("Word.Application")
End If
wd.Documents.Open (StrDocName)
    wd.Visible = True
 
 
    
Exit Sub
 
cmdOpenDocErr:
  Select Case Err.Number
    Case 381
      MsgBox "Please select a document.", vbCritical, "Document Selection Error"
    
    Case 429
    Resume RestartOpen
  End Select
 
End Sub

For Excel Termination etc....

Private Sub cmdExport_Click()
 
' Note:
' You must have a reference to the Excel Object Library.
'
Dim i           As Long
Dim j           As Long
Dim lRowCount   As Long
Dim lPasteCount As Long
Dim sLtr        As String
Dim sStart      As String
Dim sEnd        As String
Dim sRowData    As String
Dim sSelData    As String
Dim oExcelApp   As excel.Application
Dim oWs         As excel.Worksheet
Dim oWb         As excel.Workbook
 
Const cNUMCOLS = 6
Const cNUMROWS = 700
Const cFIXEDROWS = 6
Const cCLIPROWS = 500
 
On Error GoTo ErrorHandler
Screen.MousePointer = vbHourglass
If Dir(sNewXlsFile) <> "" Then Kill sNewXlsFile
'
' Create an invisible Excel instance.
'
' Open a previously created worksheet that has most
' of the desired formatting already. Save this template
' as a new file so as not to destroy it.
'
Set oExcelApp = CreateObject("EXCEL.APPLICATION")
oExcelApp.Visible = False
oExcelApp.Workbooks.Open FileName:=sXlsTemplate, ReadOnly:=True, ignoreReadOnlyRecommended:=True
Set oWs = oExcelApp.ActiveSheet
Set oWb = oExcelApp.ActiveWorkbook
oWs.SaveAs FileName:=sNewXlsFile, FileFormat:=xlNormal
'
' Populate the header information by writting
' directly to specific cells.
'
' Note:
' Strings are prefixed with a quote mark.
'
With oWs
    .Cells(1, 4).Value = "'Value1"
    .Cells(2, 4).Value = "'Value2"
    .Cells(3, 4).Value = "'Value3"
    .Cells(4, 4).Value = "'Value4 Value4 Value4 Value4 Value4 Value4"
    .Cells(5, 5).Value = "'Value5"
    .Cells(5, 6).Value = "'Value6"
    .Cells(5, 7).Value = "'Value7"
End With
'
' Now lets populate the "body" of the spreadsheet.
' Determine the range of cells to be populated
' and change their format to numeric.
'
sStart = "A" & CStr(cFIXEDROWS + 1)
sLtr = Mid$("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cNUMCOLS + 1, 1)
sEnd = sLtr & CStr(cFIXEDROWS + cNUMROWS + 1)
 
oWs.Range(sStart, sEnd).Select
oWs.Range(sStart, sEnd).Activate
oWs.Range(sStart, sEnd).NumberFormat = "#,##0.00"
'
' Populate the body of the spreadsheet.
'
sSelData = ""
lRowCount = 0
lPasteCount = 0
 
For i = 0 To cNUMROWS
    sRowData = ""
    '
    ' Create the rows to send to Excel. Each row
    ' is a tab delimited string of values terminated
    ' by a carriage return and line feed. Data can
    ' come from a grid or other source.
    '
    For j = 0 To cNUMCOLS
        sRowData = sRowData & CStr(j) & vbTab
    Next
    sRowData = Left$(sRowData, Len(sRowData) - 1)
    '
    ' Rows are accumulated into blocks then stored in
    ' the clipboard and pasted into Excel in one shot.
    '
    ' They can be written one at a time but this is
    ' faster since the data is kept in memory and
    ' there are fewer calls to Excel.
    '
    sSelData = sSelData + sRowData + vbCrLf
    lRowCount = lRowCount + 1
    
    If lRowCount = cCLIPROWS Then
        Clipboard.Clear
        Clipboard.SetText sSelData
        sSelData = ""
        With oWs
            .Range("A" & CStr(lPasteCount * cCLIPROWS + cFIXEDROWS)).Select
            .Paste
            .Range("A1").Select
        End With
        lRowCount = 0
        lPasteCount = lPasteCount + 1
    End If
Next
'
' Paste the last block of data into the worksheet.
'
Clipboard.Clear
Clipboard.SetText sSelData
With oWs
    .Range("A" & CStr(lPasteCount * cCLIPROWS + cFIXEDROWS)).Select
    .Paste
    .Range("A1").Select
End With
'
' Change the formatting on a few cells.
'
' Select and highlight a cell. Change the font
' style and color on certain parts of its contents.
'
oWs.Range("D4").Select
oWs.Range("D4").Activate
With oExcelApp.ActiveCell.Characters(Start:=1, Length:=10).Font
    .FontStyle = "Regular"
    .Size = 11
    .ColorIndex = 5
End With
With oExcelApp.ActiveCell.Characters(Start:=20, Length:=30).Font
    .FontStyle = "Italic"
    .Size = 11
    .ColorIndex = xlAutomatic
End With
'
' Just for fun, change the color of
' the first column to Red.
'
sStart = "A" & CStr(cFIXEDROWS + 1)
sEnd = "A" & CStr(cFIXEDROWS + cNUMROWS + 1)
oWs.Range(sStart, sEnd).Select
oWs.Range(sStart, sEnd).Activate
oWs.Range(sStart, sEnd).Font.ColorIndex = 3
'
' Change the border and color of the last row.
'
j = (lPasteCount * cCLIPROWS) + cFIXEDROWS + lRowCount
For i = 1 To cNUMCOLS + 1
    With oWs.Cells(j, i)
        .Borders(xlTop).LineStyle = xlDouble
        .Font.Bold = True
        .Font.ColorIndex = 3
    End With
Next
'
' Make the last row a total line. Build and insert
' a formula into its first cell. Then copy the
' formula to the remaining cells.  When it is copied
' Excel will update the cell references for you.
'
oWs.Cells(j, 1).Value = "=SUM(A" & CStr(cFIXEDROWS + 1) & ":A" & CStr(j - 1) & ")"
For i = 1 To cNUMCOLS
    oWs.Cells(j, 1).Copy
    oWs.Cells(j, i + 1).Select
    oWs.Paste
Next
'
' Save the changed worksheet.
'
oWb.Save
oWb.Saved = True
'
' Terminate and release the Excel objects.
'
oExcelApp.Quit
Set oWs = Nothing
Set oWb = Nothing
Set oExcelApp = Nothing
Screen.MousePointer = vbDefault
MsgBox "Data export complete", vbInformation, "Excel Export Example"
Exit Sub
 
ErrorHandler:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description & " (" & CStr(Err.Number) & ")", vbExclamation, "Excel Export Example"
    On Error Resume Next
    oExcelApp.Quit
    Set oWs = Nothing
    Set oWb = Nothing
    Set oExcelApp = Nothing
End Sub

hope this helps...



bindu

[binduau]

Hi There check out the program in the zip file i think it will do nicely.


Bindu

[Armbruster]

Bruce & Binduau,

I think it has to do with one of the sheet objects not closing properly. I created a test app and I can close excel without any problems . . .

Option Explicit
 
Private Declare Function FindWindow _
        Lib "user32" _
        Alias "FindWindowA" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
        
Dim ExcelApp As Excel.Application
Const gcClassnameMSExcel = "XLMAIN"
 
Public Sub CheckExcelOpen()
    Dim lngHandle As Long
    lngHandle = FindWindow(gcClassnameMSExcel, vbNullString)
    If lngHandle <> 0 Then
        MsgBox "Excel IS running"
    Else
        MsgBox "Excel is NOT running"
    End If
End Sub
Private Sub Form_Load()
    Command1.Caption = "Check Excel"
    Command2.Caption = "Open Excel"
    Command3.Caption = "Close Excel"
End Sub
Private Sub Command1_Click()
    CheckExcelOpen
End Sub
Private Sub Command2_Click()
    'open excel
    Set ExcelApp = New Excel.Application
    With ExcelApp
        .WindowState = xlMinimized
        .Visible = False
        .DisplayAlerts = False  'hide excel alerts msgboxes
    End With
End Sub
Private Sub Command3_Click()
    'close excel
    ExcelApp.Application.Quit
    Set ExcelApp = Nothing
End Sub
Private Sub Command4_Click()
    Unload Me
End Sub

Binduau - I tried the example you posted and it works like a charm!

Bruce - One of these days . . . I'm gonna take you up on that!

[binduau]

Glad to be of service man..

bindu