none
my VBS-script works fine when run manually, but I get errors when used through Scheduler RRS feed

  • General discussion

  • Hi,

    I use this script in VBS:

    ReDim pst(1)

    pst(0) = "C:\Outlook\name 1 file.pst"

    pst(1) = "C:\Outlook\name 2 file.pst"

    Const DeleteReadOnly = True

    BackupPath = "c:\BackupPSTTemp\"

    KeepHistory = FALSE

    delay = 30000

    start = TRUE

    move = TRUE

    DeleteTemp = TRUE

    Call CloseOutlook(delay)

    Call BackupPST(pst, BackupPath, KeepHistory)

    If start = TRUE Then

       Call OpenOutlook()

    End If

    If move = TRUE Then

       Call CopyAllToServer()

    End If

    If DeleteTemp = TRUE Then

       Call EraseTemp()

    End IF  

    Call NotifyWhenDone()

    Sub CloseOutlook(delay)

       strComputer = "."

       Set objWMIService = GetObject("winmgmts:" _

       & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

      

       For Each Process in objWMIService.InstancesOf("Win32_Process")

          If StrComp(Process.Name,"OUTLOOK.EXE",vbTextCompare) = 0 Then

                  Set objOutlook = CreateObject("Outlook.Application")

                       objOutlook.Quit

                       WScript.Sleep delay

                       Exit For

               End If

       Next

       Set colProcessList = objWMIService.ExecQuery _

       ("Select * from Win32_Process Where Name = 'Outlook.exe'")

       For Each objProcess in colProcessList

          objProcess.Terminate()

       Next

       Set objWMIService = Nothing

       Set ObjOutlook = Nothing

       Set colProcessList = Nothing

    End Sub

    Sub BackupPST(pst, BackupPath, KeepHistory)

      Set fso = CreateObject("Scripting.FileSystemObject")

      If KeepHistory = True Then

        ArchiveFolder = Year(Now) & "-" & Month(Now) & "-" & Day(Now)

             BackupPath = BackupPath & ArchiveFolder & "\"

      End If

      If fso.FolderExists(BackupPath) = False Then

       fso.CreateFolder BackupPath

      End If

      For Each pstPath in pst

        If fso.FileExists(pstPath) Then

          fso.CopyFile pstPath, BackupPath, TRUE

        End If

      Next

      Set fso = Nothing

    End Sub

    Sub OpenOutlook()

      Set objShell = CreateObject("WScript.Shell")

      objShell.Run "Outlook.exe"

    End Sub 

    Sub CopyAllToServer()

       With CreateObject("Scripting.FileSystemObject")

          .CopyFile "c:\BackupPSTTemp\*.*", "l:\serverpath", True

       End with

    End Sub

    Sub NotifyWhenDone()

       WScript.echo "PST-Files moved to launchpad and then copied to server."

    End Sub

    Sub EraseTemp()

       Set objFSO = CreateObject ("Scripting.FileSystemObject")

       objFSO.DeleteFile("c:\BackupPSTTemp\*"),DeleteReadOnly

    End Sub   

    Works fine untill I try running it with Scheduler.

    Then I get error "ActiveX component can't create object: 'Outlook.Appplication' Code: 800A01AD for line 46

    Line 46 being:  Set objOutlook = CreateObject("Outlook.Application")

    Any help would be greatly appreciated.

    I run this one on Win 10 with Office 2013 installed.

    Kind Regards,

    Kris

    • Changed type Bill_Stewart Monday, October 2, 2017 10:03 PM
    • Moved by Bill_Stewart Monday, October 2, 2017 10:04 PM Abandoned
    Wednesday, August 30, 2017 11:18 AM

All replies

  • Works fine untill I try running it with Scheduler.

    Microsoft Office applications are notoriously difficult to automate with the Windows task scheduler service.

    We can't troubleshoot this from afar for you, and the question is really outside this forum's scope.


    -- Bill Stewart [Bill_Stewart]


    Wednesday, August 30, 2017 1:53 PM
  • Outlook cannot be run as a task. 

    There are many third party add-ins for Outlook that will do what you are trying to do.   You could also just put a link on the users desktop that they can run when needed.


    \_(ツ)_/

    Wednesday, August 30, 2017 3:55 PM