After spending a fair amount of time looking around, I'm coming up a little stumped, as this is (I'm sure) a pretty common problem.
I run nightly backups of all our office machines, but Outlooks PST files often prevents this form successful completion. I found the solution to this for outlook, but other MS Office apps tend to block backups from successful completion as well.
I've figured out how to save and close Outlook, Word, and Excel. Access I have a solution for, but would like to close that a little more gracefully.
I've found bit's and pieces scattered about, but it seems like there should be one repository for people to find how to close all these programs. (they're not all that different after all, but there are enough differences to have thrown a serious wrench in my gears).
This was one of the most helpful articles I found. The code did not work for me, but I liked the simplistic structure and after a few tweaks I got it working.
I also looked at this StackOverflow thread, but it only addresses part of the issue (not excel..)
Here is the working code to save a document and close Word:
Dim objWord
Dim doc
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If objWord Is Nothing Then
'No need to do anything, Word is not running
Else
'Open your document and ensure its visible and activate after openning
objWord.Visible = True
objWord.Activate
Set oWS = WScript.CreateObject("WScript.Shell")
' Get the %userprofile% in a variable, or else it won't be recognized
userProfile = oWS.ExpandEnvironmentStrings( "%userprofile%" )
Dim objNetwork
Dim userName
Dim FSO
Dim Folder
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objNetwork = CreateObject("WScript.Network")
userName = objNetwork.userName
If NOT (FSO.FolderExists(userProfile + "\Desktop\Docs-You-Left-Open")) Then
FSO.CreateFolder(userProfile + "\Desktop\Docs-You-Left-Open")
End If
Do while objWord.Documents.Count <> 0
For Each doc in objWord.Documents
doc.SaveAs(userProfile + "\Desktop\Docs-You-Left-Open\" & doc.Name)
doc.Close
Next
Loop
Set doc = Nothing
objWord.quit
End If
Set objWord = Nothing
Here is the working code to gracefully close Outlook:
Dim objOutlook 'As Outlook.Application
Dim olkIns
Set objOutlook = CreateObject("Outlook.Application")
If objOutlook Is Nothing Then
'no need to do anything, Outlook is not running
Else
'Outlook running
Do while objOutlook.Inspectors.Count <> 0
For each olkIns in objOutlook.Inspectors
olkIns.Close olSave
Next
Loop
objOutlook.Session.Logoff
objOutlook.Quit
End If
Set objOutlook = Nothing
Here is the working code to close Access -- Not gracefully -- needs improvment:
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'MSACCESS.EXE'")
Set oShell = CreateObject("WScript.Shell")
For Each objProcess in colProcessList
oShell.Run "taskkill /im MSACCESS.EXE", , True
Next
And this is the Excel code that I'm trying to get, but can't seem to break through this one, where it keeps sticking on line 16 objExcel.Application.Visible = True:
Dim objExcel
Dim wkb
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then ExcelWasNotRunning = True
Err.Clear ' Clear Err object in case error occurred.
If ExcelWasNotRunning = True Then
objExcel.Application.Quit
Else
'Open your document and ensure its visible and activate after openning
objExcel.Application.Visible = True
objExcel.Activate
Set oWS = WScript.CreateObject("WScript.Shell")
' Get the %userprofile% in a variable, or else it won't be recognized
userProfile = oWS.ExpandEnvironmentStrings( "%userprofile%" )
Dim objNetwork
Dim userName
Dim FSO
Dim Folder
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objNetwork = CreateObject("WScript.Network")
userName = objNetwork.userName
If NOT (FSO.FolderExists(userProfile + "\Desktop\Docs-You-Left-Open")) Then
FSO.CreateFolder(userProfile + "\Desktop\Docs-You-Left-Open")
End If
Do while objExcel.Workbooks.Count <> 0
For Each wkb in objExcel.Workbooks
wkb.SaveAs(userProfile + "\Desktop\Docs-You-Left-Open\" & wkb.Name)
wkb.Close
Next
Loop
Set wkb = Nothing
objExcel.quit
End If
Set objExcel = Nothing
Any help on the Excel -- and why this would be hanging on:
objExcel.Application.Visible = True or how to go about closing Access gracefully (including handling errors at form closure) would be very much appreciated! And I hope this consolidation of topics helps others, so they don't have to spend an entire day trying to wrap their head around this...
