Saving and closing office programs (word, excel, a

Question

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

Answer 1

OPTION EXPLICIT
DIM strComputer,strProcess, objShell, FSO, userName, objExcel, objWorksheet, objWorkbook, Workbooks, oShell, RunTaskKill, objExcel1, objWorkbook1
SET objShell = CreateObject("Wscript.Shell")

strComputer = objShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )

strProcess = "excel.exe"




' Function to check if a process is running
FUNCTION isProcessRunning(BYVAL strComputer,BYVAL strProcessName)

    DIM objWMIService, strWMIQuery

    strWMIQuery = "Select * from Win32_Process where name like '" & strProcessName & "'"

    SET objWMIService = GETOBJECT("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" _ 
            & strComputer & "\root\cimv2") 


    IF objWMIService.ExecQuery(strWMIQuery).Count > 0 THEN
        isProcessRunning = TRUE
    ELSE
        isProcessRunning = FALSE
    END IF
END FUNCTION


IF isProcessRunning(strComputer,strProcess) THEN
Set objShell= CreateObject("WScript.Network")
userName = objShell.UserName
    Set FSO = CreateObject("Scripting.FileSystemObject")

        IF FSO.FolderExists("c:\users\" & userName & "\Desktop\Docs-You-Left-Open") Then
                wscript.echo "folder already exists"
                wscript.sleep 500
            ELSE
            FSO.CreateFolder("c:\users\" & userName & "\Desktop\Docs-You-Left-Open")
            wscript.sleep 500
            END IF
            wscript.sleep 1000

                        Set objExcel = GetObject(, "Excel.Application")
                        Set objExcel1 = CreateObject("Excel.Application")

                        objExcel.Application.Visible = True  
                        objExcel1.Application.Visible = True  
                        objExcel.AutoRecover.Enabled = False
                        objExcel1.AutoRecover.Enabled = False
                       Set  objWorkbook = objExcel.Workbooks
                       Set  objWorkbook1 = objExcel.Workbooks
                       Set objExcel1 = objExcel
                       Set  objWorkbook1 = objWorkbook
                        Do while objExcel1.Workbooks.Count <> 0
                        For Each Workbooks in objExcel1.Workbooks 
                        Workbooks.SaveAs("c:\users\" & userName & "\Desktop\Docs-You-Left-Open\" & Workbooks.Name & Timer() & ".xlsx") 
                        Workbooks.Close
                        wscript.sleep 100 
                        Next 

                        Loop


                        wscript.sleep 1000 


                            Set oShell = CreateObject ("WScript.Shell")

                             oShell.run "taskkill /f /im excel.exe",0,true
                                Set oShell = Nothing
                                wscript.quit
        ELSE
    wscript.echo strProcess & " is NOT running on computer '" & strComputer & "'"
END IF

wscript.quit