Speichern und Schließen von Office-Programmen (Word, Excel, Access, Outlook) mit VBS für Backups

Question

Nachdem ich mich ziemlich lange umgesehen habe, stehe ich ein wenig ratlos da dies (ich bin mir sicher) ein ziemlich häufiges Problem.

Ich führe nächtliche Backups aller unserer Büromaschinen durch, aber Outlook PST-Dateien verhindert oft, dass dieses Formular erfolgreich abgeschlossen wird. Ich habe die Lösung für Outlook gefunden, aber andere MS Office-Anwendungen neigen dazu, Backups auch nach erfolgreichem Abschluss zu blockieren.

Ich habe herausgefunden, wie Outlook, Word und Excel zu speichern und zu schließen. Access Ich habe eine Lösung für, aber möchte das ein wenig eleganter schließen.

Ich habe Bits und Teile verstreut gefunden, aber es scheint, dass es ein Repository geben sollte, in dem Leute finden können, wie man all diese Programme schließt. (sie sind doch gar nicht so unterschiedlich, aber es gibt genug Unterschiede, um einen ernsthaften Schraubenschlüssel in meine Gänge zu werfen).

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.

Ich sah auch bei this StackOverflow thread, but it only addresses part of the issue (not excel..)

Hier ist der ist Code arbeitet ein Dokument und schließen Sie Word speichern:

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 

Hier ist die Arbeits Code ordnungsgemäß schließen Ausblick:

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 

Hier ist der Arbeitscode Zugang zu schließen - nicht ordnungsgemäß - braucht 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 

Und das ist der Excel-Code, den ich zu bekommen habe versucht, aber kann nicht scheinen, zu durchbrechen diese, wo es 16 klebt auf der Linie hält 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 

Jede Hilfe auf dem Excel - und warum dies würde hängen:

objExcel.Application.Visible = Trueoder wie man den Zugriff Access elegant (einschließlich der Behandlung von Fehlern beim Schließen von Formularen) gehen würde sehr geschätzt werden! Und ich hoffe, dass diese Konsolidierung der Themen hilft anderen, so dass sie müssen nicht einen ganzen Tag damit verbringen, den Kopf wickeln diese um ...

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