In a cursory reading of the code nothing stands out. However, I am not
sure how XL/Windows will react to code that XL is executing that tries
to terminate it through a object variable.

As a test, have you tried running it through another program such as
Word or PowerPoint? Though, given your frequent activation of
workbooks/sheets it may not be feasible. Even better might be through
a VBScript file executed by the Windows Scripting Host.

You may also want to check Program won't quit
http://www.tushar-mehta.com/excel/vb...quit/index.htm

as well as Beyond Excel's recorder
http://www.tushar-
mehta.com/excel/vba/beyond_the_macro_recorder/index.htm

and, finally,
How to safely instantiate another Office application and close it only
if you started it
http://support.microsoft.com/default...b;en-us;555191

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

In article <2F0246FA-F554-4C9C-AFC4-71B79585814F@microsoft.com>,
PaulNottsUK@discussions.microsoft.com says...
> I'm using Excel 2000 to work on with a company payroll data. We put the data
> from the
> payroll into an excel workbook do some calculations and then use a macro to
> split the
> data into seperate workbooks by department and location. I'm using ADODB to
> connect
> the workbook back to itself so i can use SQL to select each
> department/location in turn,
> copy the recordset to a new workbook, add a code module to the new workbook
> and then
> save and close the new workbook.
> Everything seems to work ok with the process itself but at the end of it I
> end up with a
> 'ghost' excel process that if I don't 'end' manually using task manager I
> can't rerun the
> macro because the refernce to the data table can't be found.
>
> I've read several postings about this type of behaviour and I've put extra
> code in to make
> sure I'm not accidently creating another instance of Excel but the problem
> persists.
> Can anyone shed any light on this.
>
> Here is the code;
>
> Sub testme1()
> Dim cnnXL As ADODB.Connection 'Connection
> Dim rstLocs As ADODB.Recordset 'Location Recordset
> Dim rstEMPS As ADODB.Recordset 'Employee Recordset
> Dim strConn As String 'Connection string
> Dim strSQLLocs As String 'SQL for Locations
> Dim strSQLEmps As String 'SQL for Employees within Location
> Dim strSFName As String 'Workbook name for connection
> Dim strShtName As String 'New worksheet name
> Dim strPath As String 'Directory path for all files
> Dim strNFName As String 'New File name (includes path)
> Dim strWName As String 'Window Name (file name)
> Dim strCName As String 'Code file name (includes path)
> Dim intWSCnt As Integer 'Worksheet count
> Dim intMax As Integer 'Progress Bar maximum
> Dim intProg As Integer 'Progress Bar progress
> Dim fsoCMod As FileSystemObject
> Set appXL = GetObject(, "Excel.Application")
> ' Turn of screen updating
> appXL.ScreenUpdating = False
> ' Setup fixed data variables
> strSFName = appXL.ThisWorkbook.Name
> strPath = appXL.ThisWorkbook.Path
> strCName = strPath & "\code.txt"
> ' Export the module that will contain code for the workbooks created by
> this macro
> appXL.ThisWorkbook.Activate
> appXL.ThisWorkbook.VBProject.VBComponents("basExport").Export strCName
> ' Setup an ADODB connection to this workbook
> Set cnnXL = New ADODB.Connection
> cnnXL.Provider = "MSDASQL"
> cnnXL.ConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)}; DBQ="
> & strSFName
> cnnXL.Open
> ' Set the SQL to get a unique list of locations and create the recordset
> strSQLLocs = "SELECT DISTINCT [AllData].[Substantive Location],
> [AllData].[Substantive Group] "
> strSQLLocs = strSQLLocs & "FROM [AllData] ORDER BY
> [AllData].[Substantive Location]"
> Set rstLocs = cnnXL.Execute(strSQLLocs)
> ' Error if data not present
> If rstLocs.BOF And rstLocs.EOF Then
> MsgBox "Problem"
> Exit Sub
> End If
> ' Setup progress bar and display
> intMax = 60
> intProg = 1
> ProgBar (intProg / intMax) * 100
> ' Loop through the recordset of locations
> Do Until rstLocs.EOF
> ' create a new workbook and reduce the number of worksheets to 1
> appXL.Workbooks.Add
> intWSCnt = appXL.ActiveWorkbook.Sheets.Count
> appXL.DisplayAlerts = False
> If intWSCnt > 1 Then
> Do Until appXL.ActiveWorkbook.Sheets.Count = 1
>
> appXL.ActiveWorkbook.Sheets(appXL.ActiveWorkbook.Sheets.Count).Delete
> Loop
> End If
> appXL.DisplayAlerts = True
> ' Strip special characters from location name and use as workbook name
> strNFName = rstLocs(0) & " " & rstLocs(1)
> If InStr(1, strNFName, "/", vbTextCompare) > 0 Then
> strNFName = Replace(strNFName, "/", " ", 1, , vbTextCompare)
> ElseIf InStr(1, strNFName, "&", vbTextCompare) > 0 Then
> strNFName = Replace(strNFName, "&", " ", 1, , vbTextCompare)
> Else
> strNFName = strNFName
> End If
> strWName = strNFName
> strNFName = strPath & "\" & strNFName
> appXL.ActiveWorkbook.SaveAs strNFName
> ' Copy data column headings from this workbook and paste into new workbook
> appXL.ThisWorkbook.Activate
> appXL.Range("ColHeads").Copy
> appXL.Workbooks(strWName).Activate
> appXL.ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial
> ' Import the code module to be used in the new workbook
> appXL.Workbooks(strWName).Activate
> appXL.ActiveWorkbook.VBProject.VBComponents.Import strCName
> ' Save the new workbook
> appXL.ActiveWorkbook.Save
> ' Switch to this workbook
> appXL.ThisWorkbook.Activate
> ' Set the SQL to extract the data for a given location
> strSQLEmps = "SELECT * FROM [AllData] WHERE ([AllData].[Substantive
> Location]='" & rstLocs(0)
> strSQLEmps = strSQLEmps & "' AND [AllData].[Substantive Group]='" &
> rstLocs(1) & "' )"
> ' Create a recordset containg the employees for a given location
> Set rstEMPS = New ADODB.Recordset
> Set rstEMPS = cnnXL.Execute(strSQLEmps)
> ' Swithc to the new workbook and insert the data from the employee recordset
> appXL.Workbooks(strWName).Activate
> appXL.Selection.Offset(1, 0).CopyFromRecordset rstEMPS
> ' Save the new workbook
> appXL.ActiveWorkbook.Save
> appXL.ActiveWorkbook.Close
> appXL.ThisWorkbook.Activate
> ' Close the employee recordset
> rstEMPS.Close
> Set rstEMPS = Nothing
> ' loop to the next location
> rstLocs.MoveNext
> ' update progress bar
> intProg = intProg + 1
> ProgBar (intProg / intMax) * 100
> Loop
> ' Close location recordset
> rstLocs.Close
> Set rstLocs = Nothing
> ' Close the connection to the workbook
> cnnXL.Close
> Set cnnXL = Nothing
> ' Delete code module
> Set fsoCMod = CreateObject("Scripting.FileSystemObject")
> If fsoCMod.FileExists(strCName) Then
> fsoCMod.DeleteFile strCName
> End If
> Set fsoCMod = Nothing
> ' Reset screen updating and status bar
> appXL.ScreenUpdating = False
> appXL.StatusBar = ""
> Set appXL = Nothing
> End Sub
>
>