Closing xls from within Access2K VBA

[mdmilner]

I'm using A2K VBA to pass information into an xls.
My problem seems identical to this thread over in the Excel Forum (here)

http://www.mrexcel.com/board2/viewtopic.php?t=73271&highlight=quit

Which at the bottom referred me to:

http://support.microsoft.com/default.aspx?scid=kb;en-us;199219&Product=xlw2K

So, I adjusted my code to remove With..End With and also to try to close the objects then quit the application. At this point, although I might stumble into it in the next 5 minutes to 5 days -- I was hoping somebody might point out the error of my ways.

Near the bottom of the below you'll probably notice the variety of methods I was playing with (most commented out) tinkering with it.

Here's my code:
It runs precisely the way I want it to run, EXCEPT for closing excel completely.

Sub sMoveToXLS()
Dim dbs As DAO.Database
Dim rsO, rs As DAO.Recordset
Dim intMaxCol, intMaxRow As Integer
Dim objXL As Excel.Application
Dim objWkb As Workbook
Dim objSht As Worksheet
Dim strFile, strSheet, strSQL As String
Dim x, y, z As Long

Set dbs = CurrentDb()
strFile = "S:\AssignmentList\Incidents.xls"
strSheet = "Sheet1"

strSQL = "SELECT * FROM tblRep"
Set rsO = dbs.OpenRecordset(strSQL, dbOpenSnapshot)  ' Open File to get fieldnames

' Open Excel/Workbook/Worksheet
Set objXL = New Excel.Application
'With objXL
  objXL.Visible = True
  Set objWkb = objXL.Workbooks.Open(strFile)
  On Error Resume Next
  Set objSht = objWkb.Worksheets(strSheet)
  If Not Err.Number = 0 Then
    Set objSht = objWkb.Worksheets.Add
    objSht.Name = "Sheet1"
  End If
  Err.Clear
  On Error GoTo 0

  With rsO
    ' Build SQL to create new recordset to write into already open xls
    z = 3  ' First Row to drop data
    For x = 1 To 3
      strSQL = .Fields(0).Name & ", " & .Fields(1).Name
      For y = (x * 3 - 1) To (x * 3 + 1)
        strSQL = strSQL & ", " & .Fields(y).Name
      Next y
      strSQL = "SELECT TOP 5 " & strSQL & " FROM tblRep"
      strSQL = strSQL & " WHERE " & .Fields(x * 3 - 1).Name & " > 0"
      strSQL = strSQL & " ORDER BY " & .Fields(x * 3 - 1).Name & " DESC"
    
      'If rs Then Set rs = Nothing                      ' Remove it if it exists
      'Set rs = Nothing
      Set rs = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
  
      With rs
        intMaxCol = .Fields.Count
        If .RecordCount > 0 Then
          .MoveLast
          .MoveFirst
          If intMaxRow > 0 Then
            z = z + intMaxRow + 4         ' IntMaxRow from prior iteration
          End If
          intMaxRow = .RecordCount
          objSht.Range(objSht.Cells(z, 1), objSht.Cells(z + intMaxRow, intMaxCol)).CopyFromRecordset rs
        End If
      End With   'rs
      Set rs = Nothing
    Next x
  End With     'rsO
'End With       'objXL
  'On Error Resume Next
  'objXL.Visible = False
  'objXL.DisplayAlerts = False
  'MsgBox strFile
  'objSht.SaveAs (strFile)
  'Excel.ActiveWindow.Close
  'Excel.Application.Quit   ' Close Excel
  'objXL.DisplayAlerts = True

Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Excel.ActiveWindow.Close
Excel.Application.Quit   ' Close Excel
Set rs = Nothing
Set rsO = Nothing
Set dbs = Nothing
End Sub

 

[CT Witter]

Try this kb article
http://support.microsoft.com/default.aspx?scid=kb;en-us;145770&Product=acc

HTH,
CT

 

[mdmilner]

Excellent! Seems to work just fine.
I'm not real clear which may have done the final trick though. My code was modified to match the other entry (remove With...End With). It's even possible I had a working function and altered it while fiddling. Whole thing is test at this point.

I ended up settling with:

objXL.DisplayAlerts = False
objWkb.Close True, strFile
objXL.DisplayAlerts = True
objXL.Quit

Wanna see what I was thinking about using?
Kinda messy but uses DOS level Kill command matching a pattern. Of course, this would have killed whichever entry was first if several existed.

Sub sDeleteTarget(ByVal MyTarg As String)

MyTarg = " /c Kill " & MyTarg
'MyTarg = "excel.xls"
Call Shell(Environ$("COMSPEC") & MyTarg, vbNormalFocus)
DoEvents

End Sub

Thanks

Mike