Microsoft Communicator Clean Cache

This Script will clean Microsoft Communicator cache and solve minor issues:




Option Explicit
'On Error Resume Next

'==== variables =========================================
Dim LocalAppData, ProgramFiles
Dim WshShell, objFSO
Dim Result , strTiempo
Dim objWMIService, colProcessList, objProcess
Dim strAPP
Dim strComputer, colFolders, objFolder, objShell ', errResults
Dim rutaFile, ofso
Dim arrFolders()
Dim intSize, i
intSize = 0
ReDim Preserve arrFolders(intSize)
strTiempo = (600000)

'==== Object Creation. ================================================
Set WshShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
rutaFile = WshShell.ExpandEnvironmentStrings("%userprofile%") & _
"\ocs_" & WshShell.ExpandEnvironmentStrings("%username%") & ".log"
AddLog ("························································································")

'Carpeta cache a borrar
LocalAppData = WshShell.ExpandEnvironmentStrings("%LocalAppData%") & "\Microsoft\Communicator\"
AddLog ("LocalAppData: " & LocalAppData)
'Ejecutable del communicator
ProgramFiles = "'" & WshShell.ExpandEnvironmentStrings("%ProgramFiles%") & "\Microsoft Office Communicator" & "'"
AddLog ("ProgramFiles: " & ProgramFiles)
strAPP = "communicator.exe"
strComputer = "."

'==== Functions Calling. ===========================================
checkFolder
killAPP
delFolders
exeAPP
CleanUp

'==== Verify if MC folder exist ===================
Sub checkFolder
    Set objFSO = CreateObject("Scripting.FileSystemObject")   
    If objFSO.FolderExists(LocalAppData) Then       
        AddLog ("Carpeta OCS disponible")
        LocalAppData = LocalAppData & "*.es"
        'LocalAppData=Replace(LocalAppData,"\","\\")
        AddLog ("Formato carpeta con comodines: " & LocalAppData)
    Else
        AddLog "Carpeta OCS no existe. (WARNING)"
        WScript.Quit (0)
    End If
End Sub

Sub delFolders()   
    Result = objFSO.DeleteFolder(LocalAppData)
    If Result <> 0 Then
        AddLog ("No se puede borrar la carpeta, codigo de error: " & Result)
        WScript.Quit(Result)
    End If
End Sub

'==== Kill active sessions + msg box ===============================
Sub killAPP()
    'Matar el proceso communicator.exe con mensaje de advertencia.
    'Set WshShell = CreateObject("WScript.Shell")
    Result = WshShell.Popup("                          !!! ATENCIÓN!!!" _
    &vbCrLf&vbCrLf& "Se va a iniciar la actualización de contactos OCS. "_
    &vbCrLf& "Dispone de 10 min para cancelar conversaciones OCS, " _
    &vbCrLf& "antes de que se cierre esta aplicación durante el proceso de actualización…" _
    &vbCrLf&vbCrLf& "Si pulsas OK , Comenzará la Instalación ahora" _
    &vbCrLf&vbCrLf& "---------------------------------------------------------------------------" _
    &vbCrLf&vbCrLf& "                          !!! ATTENTION !!!" _
    &vbCrLf&vbCrLf& "OCS contacts update process ready to start" _
    &vbCrLf& "You have 10 min to cancel your OCS conversations, " _
    &vbCrLf& "before this application close to start update activity…" _
    &vbCrLf&vbCrLf& "If you click OK, the installation will start now" , strTiempo, "T-Systems",48)   
    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\localhost\root\cimv2")
    Set colProcessList = objWMIService.ExecQuery ("SELECT * FROM Win32_Process WHERE name = '"& strAPP & "'")
    If colProcessList.count = 0 Then AddLog ("Aplicacion OCS no esta en ejecucion")
    For Each objProcess In colProcessList
        Result = objProcess.Terminate()
        If Result <> 0 Then
            AddLog ("ERROR cerrando OCS - codigo de error: " & Result)
            WScript.Quit (Result)
        End If
        AddLog ("Proceso OCS eliminado correctamente")
    Next
    WScript.Sleep(strTiempo/60)
End Sub

'==== Execute MC. ======================================================
Sub exeAPP
    WScript.Sleep(strTiempo/60)
    Set objShell = CreateObject("WScript.Shell")
    Result = objShell.Run (strAPP,1,False)
    If Result <> 0 Then
        AddLog ("ERROR - OCS no se ha podido ejecutar correctamente. Codigo error: " & Result)
    Else   
        AddLog ("Ejecutado OCS correctamente")
    End If           
End Sub

'==== LOGS. ======================================================
Sub AddLog (Texto)
    Dim Fichero
    Set Fichero = objFSO.opentextfile (rutaFile, 8, True)
    Fichero.Writeline Date & "_" & Time & " | " & Texto
    Fichero.Close
End Sub

'==== Kill objects. =====================================================
Function CleanUp()
    AddLog ("Programa finalizado")
    Set WshShell  = Nothing
    Set objFSO  = Nothing
    Set objWMIService  = Nothing
    Set colProcessList  = Nothing
    Set objShell  = Nothing   
End Function