Closing xls from within Access2K VBA

mdmilner

Well-known Member
Joined
Apr 30, 2003
Messages
1,352
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.

Code:
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
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

mdmilner

Well-known Member
Joined
Apr 30, 2003
Messages
1,352
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:

Code:
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.

Code:
Sub sDeleteTarget(ByVal MyTarg As String)

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

End Sub

Thanks

Mike
 

Watch MrExcel Video

Forum statistics

Threads
1,129,814
Messages
5,638,493
Members
417,029
Latest member
lingx86

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top