TheBugSlayer
Programmer
I have a procedure that opens a text file in Excel and does some formatting. However the Excel application is not visible but I see it as a process in Task Manager and, even when a close it and free the objects it still remains in there, preventing me from running the program again if I don't close it manually.
Can anybody help? See code below.
Can anybody help? See code below.
Code:
[b]
Private Sub PrepData(CCtr As String, DataFileName As String)
Dim XLApp As New Excel.Application
Application.DisplayAlerts = False
With XLApp
[COLOR=red]
'WindowState = xlNormal
Visible = True
[/color]
Workbooks.OpenText DataFileName, _
Origin:=xlWindows, StartRow:=6, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 1), Array(1, 2), Array(10, 3), Array(18, 2), Array(74, 2), Array(90, 2), _
Array(106, 9), Array(130, 2))
Range("B1").Select
Selection.Cut
Range("C1").Select
ActiveSheet.Paste
Dim y As Integer
y = 1
Dim Current As Excel.Range
While Cells.Item(y, 1) <> ""
Set Current = Cells.Item(y, 1)
If IsDate(Cells.Item(y, 3)) Then
Cells.Item(y, 11).Value = CCtr
Cells.Item(y, 12).Value = Cells.Item(1, 3).Value
Else
Cells.Item(y, 3).EntireRow.Delete
y = y - 1
End If
y = y + 1
Wend
Rows("1:1").Select
Selection.Delete Shift:=xlUp
y = 2
While Cells.Item(y, 1) <> ""
Range(Cells(y, 3), Cells(y, 4)).Select
Selection.Copy
ActiveSheet.Paste Destination:=Cells(y - 1, 8)
Cells(y, 3).EntireRow.Delete
y = y + 1
Wend
Columns("I:I").Select
Selection.TextToColumns Destination:=Range("I1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(33, 2))
Columns("E:H").Select
Selection.Insert Shift:=xlToRight
Columns("D:D").Select
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(17, 2), Array(20, 2), Array(23, 2), Array(41, 2))
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("L:L").Select
Selection.Replace What:="EFT", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1:O1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
End With
AppActivate "notepad"
SendKeys "^V"
[COLOR=red]
XLApp.Quit
Set XLApp = Nothing
[/color]
Application.DisplayAlerts = True
End Sub
[/b]