Supported Windows versions:

• Microsoft Windows 7 or higher
• Microsoft Windows 2008 R2 or higher

ProblemStepsRecorderHelper_v1.0.vbs

' ##############################################################################
' #                                Lupi Gabriel                                #
' #                             www.lupigabriel.it                             #
' #                            info@lupigabriel.it                             #
' ##############################################################################
' #            Copyright (c) 2014 Lupi Gabriel All rights reserved.            #
' ##############################################################################
' # NAME       : Problem Steps Recorder Helper                                 #
' # VERSION    : 1.0                                                           #
' # FILE       : ProblemStepsRecorderHelper_v1.0.vbs                           #
' # CLASS      : Script                                                        #
' # LANGUAGE   : VB Script                                                     #
' ##############################################################################

On Error Resume Next

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

If objFSO.FileExists(objShell.ExpandEnvironmentStrings("%SystemRoot%") & "\System32\psr.exe") = False Then
	Result = MsgBox("Warning! This Windows version is not supported!", vbOKOnly+vbExclamation, "Problem Steps Recorder Helper - Warning")
	Wscript.Quit
End If

If objFSO.FileExists(objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%") & "\PSR\" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip") = True Then
	objFSO.DeleteFile objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%") & "\PSR\" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip"
End If

Result = MsgBox("This application enable you to record their interactions with an application and provide a detailed screen-by-screen view with accompanying information. Learn how the recording can be used to quickly identify problems and help reduce time spent with the help desk." & vbCrLf & vbCrLf & "Typed data are not recorded, but if necessary you can use the" & vbCrLf & "[ Add Comment ] on the pop-up to add a description to the step." & vbCrLf & vbCrLf & "Close the pop-up recording when the procedure is finished.", vbOKCancel+vbInformation, "Problem Steps Recorder Helper - Info")
If Result = 2 Then
	Wscript.Quit
End If

Result = MsgBox("Warning! Typed data are not recorded, however you have to be careful for confidential information that may be recorded in the captured screens!", vbOKCancel+vbExclamation, "Problem Steps Recorder Helper - Warning")
If Result = 2 Then
	Wscript.Quit
End If

If objFSO.FolderExists(objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%") & "\PSR") = False Then
	objFSO.CreateFolder objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%") & "\PSR"
End If

objShell.run "psr.exe /start /output """ & objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%") & "\PSR\" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip""",1,1

If objFSO.FileExists(objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%") & "\PSR\" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip") = True Then
	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
	Set colProcessList = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'OUTLOOK.EXE'")
	CheckOutlook = 0
	For Each objProcess in colProcessList
		colProperties = objProcess.GetOwner(strNameOfUser,strUserDomain)
		If strNameOfUser = objShell.ExpandEnvironmentStrings("%USERNAME%") Then
			CheckOutlook = 1
			Result = MsgBox("Do you want to send this registration with Outlook?", vbOKCancel+vbInformation, "Problem Steps Recorder Helper - Send")
			If Result = 1 Then
				Set myOlApp = CreateObject("Outlook.Application")
				Set myItem = myOlApp.CreateItem(olMailItem)
				myItem.Attachments.Add(objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%") & "\PSR\" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip")
				myItem.Display
			Else
				objFSO.MoveFile objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%") & "\PSR\" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip", objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip"
				Result = MsgBox("The recording is saved on your Desktop in the file named ''" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip'' and path of the file has been copied to your clipboard.", vbOKOnly+vbInformation, "Problem Steps Recorder Helper - Save")
				Set oExec = objShell.Exec("clip")
				Set oIn = oExec.stdIn
				oIn.WriteLine objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip"
				oIn.Close
				Set oIn = Nothing
				Set oExec = Nothing
			End If
		End If
	Next
	If CheckOutlook = 0 Then
		objFSO.MoveFile objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%") & "\PSR\" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip", objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip"
		Result = MsgBox("The recording is saved on your Desktop in the file named ''" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip'' and path of the file has been copied to your clipboard.", vbOKOnly+vbInformation, "Problem Steps Recorder Helper - Save")		
		Set oExec = objShell.Exec("clip")
		Set oIn = oExec.stdIn
		oIn.WriteLine objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip"
		oIn.Close
		Set oIn = Nothing
		Set oExec = Nothing
	End If
Else
	Result = MsgBox("Warning! The recording has not been created!", vbOKOnly+vbExclamation, "Problem Steps Recorder Helper - Warning")
End If

WScript.Sleep(3000)

If objFSO.FileExists(objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%") & "\PSR\" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip") = True Then
	objFSO.DeleteFile objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%") & "\PSR\" & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & "_" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "_psr.zip"
End If

Set myItem = Nothing
Set myOlApp = Nothing
Set colProcessList = Nothing
Set objWMIService = Nothing
Set objShell = Nothing
Set objFSO = Nothing

This script can be used in all Microsoft Windows Systems running the following command…

• cscript.exe /nologo CheckDiskPredictive_v1.0.vbs C: 95 98

… Or can be integrated into the file nrpe.cfg of NRPE_NT (Nagios Agent for Windows)

CheckDiskPredictive_v1.0.vbs

' ##############################################################################
' #                                Lupi Gabriel                                #
' #                             www.lupigabriel.it                             #
' #                            info@lupigabriel.it                             #
' ##############################################################################
' #            Copyright (c) 2014 Lupi Gabriel All rights reserved.            #
' ##############################################################################
' # NAME       : Nagios Windows Check Disk with Predictive Analysis            #
' # VERSION    : 1.0                                                           #
' # FILE       : CheckDiskPredictive_v1.0.vbs                                  #
' # CLASS      : Script                                                        #
' # LANGUAGE   : VB Script                                                     #
' ##############################################################################

On Error Resume Next

DriveUnit = Wscript.Arguments(0) ' Drive
PercentWarning = Wscript.Arguments(1) ' % Used Space for Warning
PercentCritical = Wscript.Arguments(2) ' % Used Space for Critical
PredictiveWarning = 3 ' Day Range for Predictive Warning
PredictiveCritical = 1 ' Day Range for Predictive Critical
PredictiveStep = 60 ' Max Log Lines 
PredictiveStepSens = 6 ' Use Log Line every # of Log Lines

PredictiveLog = "CheckDisk_" & UCase(Replace(DriveUnit, ":", "")) & "_Predictive.txt"


Set fso = CreateObject("Scripting.FileSystemObject")
Set d = fso.GetDrive(DriveUnit)

UsedPercent = Round ((d.TotalSize - d.FreeSpace) * 100 / d.TotalSize, 2)
UsedSpace = "Used: " & Round ((d.TotalSize - d.FreeSpace)) & " B (" & UsedPercent & "%)"
If (d.TotalSize - d.FreeSpace) > 1023 Then
	UsedSpace = "Used: " & Round ((d.TotalSize - d.FreeSpace) / 1024 , 2) & " B (" & UsedPercent & "%)"
End If
If (d.TotalSize - d.FreeSpace) > 1048575 Then
	UsedSpace = "Used: " & Round ((d.TotalSize - d.FreeSpace) / 1024 / 1024 , 2) & " MB (" & UsedPercent & "%)"
End If
If (d.TotalSize - d.FreeSpace) > 1073741823 Then
	UsedSpace = "Used: " & Round ((d.TotalSize - d.FreeSpace) / 1024 / 1024 / 1024 , 2) & " GB (" & UsedPercent & "%)"
End If
If (d.TotalSize - d.FreeSpace) > 1099511627775 Then
	UsedSpace = "Used: " & Round ((d.TotalSize - d.FreeSpace) / 1024 / 1024 / 1024 / 1024 , 2) & " TB (" & UsedPercent & "%)"
End If

FreePercent = Round (d.FreeSpace * 100 / d.TotalSize)
FreeSpace = "Free: " & Round (d.FreeSpace) & " B (" & FreePercent & "%)"
If d.FreeSpace > 1023 Then
	FreeSpace = "Free: " & Round (d.FreeSpace / 1024 , 2) & " B (" & FreePercent & "%)"
End If
If d.FreeSpace > 1048575 Then
	FreeSpace = "Free: " & Round (d.FreeSpace / 1024 / 1024 , 2) & " MB (" & FreePercent & "%)"
End If
If d.FreeSpace > 1073741823 Then
	FreeSpace = "Free: " & Round (d.FreeSpace / 1024 / 1024 / 1024 , 2) & " GB (" & FreePercent & "%)"
End If
If d.FreeSpace > 1099511627775 Then
	FreeSpace = "Free: " & Round (d.FreeSpace / 1024 / 1024 / 1024 / 1024 , 2) & " TB (" & FreePercent & "%)"
End If

LineCount = 0
If (fso.FileExists (PredictiveLog)) Then
	Set objFile = fso.OpenTextFile(PredictiveLog, 1)
	Do Until objFile.AtEndOfStream
		Line = objFile.ReadLine
		If Line <> "" Then
			LineCount = LineCount + 1
		End If
	Loop
	objFile.Close
	Set objFile = Nothing
End If

StepCount = 0
StepAllLines = ""
If LineCount > PredictiveStep - 1 Then
	Set objFile = fso.OpenTextFile(PredictiveLog, 1)
	Do Until objFile.AtEndOfStream
		StepLine = objFile.ReadLine
		If StepLine <> "" Then
			StepCount = StepCount + 1
			If StepCount > (LineCount - PredictiveStep + 1) Then
				If StepCount = LineCount Then
					StepAllLines = StepAllLines & StepLine
				Else
					StepAllLines = StepAllLines & StepLine & vbCrLf
				End If
			End If
		End If
	Loop
	objFile.Close
	Set objFile = Nothing
	Set objFile = fso.OpenTextFile(PredictiveLog, 2, True)
	objFile.WriteLine(StepAllLines)
	objFile.Close
	Set objFile = Nothing
End If

Set objFile = fso.OpenTextFile(PredictiveLog, 8, True)
objFile.WriteLine(UsedPercent & " | " & Now)
objFile.Close
Set objFile = Nothing

LineCount = 0
LineSensTotal = 0
LineSensCount = 0
PercentStep = 0
PercentLastStep = 0
TimeStep = "FirstLine"
TimeStepLast = ""
If (fso.FileExists (PredictiveLog)) Then
	Set objFile = fso.OpenTextFile(PredictiveLog, 1)
	Do Until objFile.AtEndOfStream
		Line = objFile.ReadLine
		If Line <> "" And InStr(Line, " | ") > 0 Then
			LineSplit = Split(Line, " | ")
			LineCount = LineCount + 1
			LineSensCount = LineSensCount + 1
			If LineSensCount = 1 Then
				If TimeStep = "FirstLine" Then
					TimeStep = 0
					TimeStepLast = LineSplit(1)
					PercentLastStep = LineSplit(0)
				Else
					TimeStep = TimeStep + DateDiff("s", TimeStepLast, LineSplit(1))
					TimeStepLast = LineSplit(1)
					PercentStep = PercentStep + (LineSplit(0) - PercentLastStep)
					PercentLastStep = LineSplit(0)
				End If
				LineSensTotal = LineSensTotal + 1
			End If
			If LineSensCount = PredictiveStepSens Then LineSensCount = 0 End If
		End If
	Loop
	objFile.Close
	Set objFile = Nothing
End If

PercentStep = Round(PercentStep / (LineSensTotal - 1), 2)
TimeStep = Round(TimeStep / (LineSensTotal - 1), 2)
PredictivePercent = LineSplit(0)
PredictiveTime = LineSplit(1)
PredictiveTotalStep = Round(PredictiveWarning * 24 * 60 * 60 / TimeStep)
PredictiveStatus = 0
PredictiveBreakDate = ""
PredictiveBreakStep = 0
If PercentStep > 0 And PredictiveStep = LineCount Then
	For i = 1 to PredictiveTotalStep
		PredictivePercent = Round(PredictivePercent + PercentStep, 2)
		PredictiveTime = DateAdd("s", TimeStep, PredictiveTime)
		If PredictivePercent >= 100 Then
			PredictiveBreakStep = Round(i * TimeStep / 60 / 60 / 24, 2)
			If PredictiveBreakStep < PredictiveWarning Then PredictiveStatus = 1 End If
			If PredictiveBreakStep < PredictiveCritical Then PredictiveStatus = 2 End If
			i = PredictiveTotalStep
			PredictiveBreakDate = vbCrLf & "Predictive Disk Full: " & PredictiveTime
		End If
	Next
End If

Wscript.Echo UsedSpace & " " & FreeSpace & PredictiveBreakDate

Set d = Nothing
Set fso = Nothing

If PredictiveStatus = 1 Then Wscript.Quit 1 End If
If PredictiveStatus = 2 Then Wscript.Quit 2 End If
If CInt(UsedPercent) < CInt(PercentCritical) And CInt(UsedPercent) < CInt(PercentWarning) Then Wscript.Quit 0 End If
If CInt(UsedPercent) < CInt(PercentCritical) And CInt(UsedPercent) >= CInt(PercentWarning) Then Wscript.Quit 1 End If
If CInt(UsedPercent) >= CInt(PercentCritical) And CInt(UsedPercent) >= CInt(PercentWarning) Then Wscript.Quit 2 End If
Wscript.Quit 3

Requirements:

• CyberArk PrivateArk
• Microsoft Windows 7 or higher

PrivateArkWorkspaceLink_v1.0.vbs

' ##############################################################################
' #                                Lupi Gabriel                                #
' #                             www.lupigabriel.it                             #
' #                            info@lupigabriel.it                             #
' ##############################################################################
' #            Copyright (c) 2014 Lupi Gabriel All rights reserved.            #
' ##############################################################################
' # VERSION    : 1.0                                                           #
' # FILE       : PrivateArkWorkspaceLink_v1.0.vbs                              #
' # CLASS      : Script                                                        #
' # LANGUAGE   : VB Script                                                     #
' # OUPUT      : "%UserProfile%\Links"                                         #
' ##############################################################################



On Error Resume Next

Set oShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(oShell.ExpandEnvironmentStrings("%PROGRAMFILES%") & "\PrivateArk\Client\Arkui.exe") = True Or objFSO.FileExists(oShell.ExpandEnvironmentStrings("%PROGRAMFILES(X86)%") & "\PrivateArk\Client\Arkui.exe") = True Then
	If objFSO.FileExists(oShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Links\Workspace.lnk") = False Then
		If objFSO.FolderExists(oShell.ExpandEnvironmentStrings("%APPDATA%") & "\CyberArk\PrivateArk\Workspace") = True Then
			Set oShortCut = oShell.CreateShortcut(oShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Links\Workspace.lnk")
			oShortCut.TargetPath = oShell.ExpandEnvironmentStrings("%APPDATA%") & "\CyberArk\PrivateArk\Workspace"
			oShortCut.Save
		End If
	End If
Else
	If objFSO.FileExists(oShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Links\Workspace.lnk") = True Then
		objFSO.DeleteFile oShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Links\Workspace.lnk"
	End If
End If

Tested on the following Outlook versions:

• Microsoft Outlook 2010 (32bit)
• Microsoft Outlook 2013 (32bit)

Tested on the following Microsoft OS versions:

• Microsoft Windows XP (32bit)
• Microsoft Windows 7 (32bit)
• Microsoft Windows 8.1
• Microsoft Windows 2003 (32bit)
• Microsoft Windows 2008 R2

Tested on the following Application Virtualizer:

• VMware XenApp 6

OutlookSignature.vbs

' ##############################################################################
' #                                Lupi Gabriel                                #
' #                             www.lupigabriel.it                             #
' #                            info@lupigabriel.it                             #
' ##############################################################################
' #            Copyright (c) 2014 Lupi Gabriel All rights reserved.            #
' ##############################################################################
' # VERSION    : 1.0                                                           #
' # FILE       : OutlookSignature.vbs                                          #
' # CLASS      : Script                                                        #
' # LANGUAGE   : VB Script                                                     #
' # OUPUT      : "%AppData%\Microsoft\Signatures"                              #
' ##############################################################################



On Error Resume Next



' SETTINGS
OutlookSignatureVersion = "000" ' set to 000 to refresh signature on every logon
OutlookSignatureBinName = Array(79,0,117,0,116,0,108,0,111,0,111,0,107,0,83,0,105,0,103,0,110,0,97,0,116,0,117,0,114,0,101,0,0,0)
OutlookSignatureFirsNew = 1 ' automatic activation of the signature for new messages
OutlookSignatureFirsRep = 1 ' automatic activation of the signature for replies and forwards
OutlookSignatureRefrNew = 1 ' force re-activation of the signature for new messages on every logon
OutlookSignatureRefrRep = 1 ' force re-activation of the signature for replies and forwards messages on every logon



' START
OutlookSignatureRemPath = Replace(Wscript.ScriptFullName, Wscript.ScriptName, "")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
SignatureFlag = oShell.ExpandEnvironmentStrings("%APPDATA%") & "\Microsoft\Signatures\OutlookSignature_files\OutlookSignature." & OutlookSignatureVersion
SignatureFrst = oShell.ExpandEnvironmentStrings("%APPDATA%") & "\Microsoft\Signatures\OutlookSignature_files\OutlookSignature.first"
SignaturePath = oShell.ExpandEnvironmentStrings("%APPDATA%") & "\Microsoft\Signatures\"
UserDeskTempl = oShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\OutlookSignature\"
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
SetRegCounter = 0



' TEMPLATE
If objFSO.FileExists(OutlookSignatureRemPath & "OutlookSignature.txt") = False Or objFSO.FileExists(OutlookSignatureRemPath & "OutlookSignature.htm") = False Or objFSO.FolderExists(OutlookSignatureRemPath & "OutlookSignature_files") = False Then
TextMsgBox = "Create from Outlook the New Signature Template named ""OutlookSignature"" with the following Tags..." & vbCrLf & vbCrLf & _
"###FIRSTNAME###" & vbCrLf & _
"###INITIALS###" & vbCrLf & _
"###LASTNAME###" & vbCrLf & _
"###DISPLAYNAME###" & vbCrLf & _
"###DESCRIPTION###" & vbCrLf & _
"###OFFICENAME###" & vbCrLf & _
"###TELEPHONE###" & vbCrLf & _
"###OTHERTELEPHONE###" & vbCrLf & _
"###EMAIL###" & vbCrLf & _
"###WEBPAGE###" & vbCrLf & _
"###OTHERWEBPAGE###" & vbCrLf & _
"###STREETADDRESS###" & vbCrLf & _
"###POSTOFFICEBOX###" & vbCrLf & _
"###CITY###" & vbCrLf & _
"###STATE###" & vbCrLf & _
"###POSTALCODE###" & vbCrLf & _
"###COUNTRYCODE###" & vbCrLf & _
"###HOMEPHONE###" & vbCrLf & _
"###OTHERHOMEPHONE###" & vbCrLf & _
"###PAGER###" & vbCrLf & _
"###OTHERPAGER###" & vbCrLf & _
"###MOBILEPHONE###" & vbCrLf & _
"###OTHERMOBILEPHONE###" & vbCrLf & _
"###FAX###" & vbCrLf & _
"###OTHERFAX###" & vbCrLf & _
"###IPPHONE###" & vbCrLf & _
"###OTHERIPPHONE###" & vbCrLf & _
"###NOTES###" & vbCrLf & _
"###JOBTITLE###" & vbCrLf & _
"###DEPARTMENT###" & vbCrLf & _
"###COMPANY###" & vbCrLf & _
"###MANAGER###" & vbCrLf & _
vbCrLf & "Save Template from Outlook and click ""OK"" to create OutlookSignature Source Files..."
UserMsg = MsgBox(TextMsgBox, 0, "OutlookSignature")
If objFSO.FileExists(SignaturePath & "OutlookSignature.txt") = False Or objFSO.FileExists(SignaturePath & "OutlookSignature.htm") = False Or objFSO.FolderExists(SignaturePath & "OutlookSignature_files") = False Then
UserMsg = MsgBox("Warning! OutlookSignature Template is not present in Outlook..." & vbCrLf & vbCrLf & "You Must Create Template and Re-launch the Script...", 0, "OutlookSignature")
Wscript.Quit
End If
If objFSO.FolderExists(OutlookSignatureRemPath & "OutlookSignature_files\") = True Then objFSO.DeleteFolder OutlookSignatureRemPath & "OutlookSignature_files\" End If
If objFSO.FileExists(OutlookSignatureRemPath & "OutlookSignature.htm") = True Then objFSO.DeleteFile OutlookSignatureRemPath & "OutlookSignature.htm" End If
If objFSO.FileExists(OutlookSignatureRemPath & "OutlookSignature.txt") = True Then objFSO.DeleteFile OutlookSignatureRemPath & "OutlookSignature.txt" End If
objFSO.CreateFolder OutlookSignatureRemPath & "OutlookSignature_files\"
objFSO.CopyFile SignaturePath & "OutlookSignature.txt", OutlookSignatureRemPath
objFSO.CopyFile SignaturePath & "OutlookSignature.htm", OutlookSignatureRemPath
objFSO.CopyFile SignaturePath & "OutlookSignature_files\*", OutlookSignatureRemPath & "OutlookSignature_files\"
If objFSO.FileExists(OutlookSignatureRemPath & "OutlookSignature.txt") = False Or objFSO.FileExists(OutlookSignatureRemPath & "OutlookSignature.htm") = False Or objFSO.FolderExists(OutlookSignatureRemPath & "OutlookSignature_files") = False Then
UserMsg = MsgBox("Warning! OutlookSignature Template files are not copied in source path..." & vbCrLf & vbCrLf & "Please check write permission in source path and Re-launch the Script...", 0, "OutlookSignature")
Wscript.Quit
End If
UserMsg = MsgBox("OutlookSignature Template is now created and copied in source path..." & vbCrLf & vbCrLf & OutlookSignatureRemPath, 0, "OutlookSignature")
Wscript.Quit
End If


' DEPLOY
If objFSO.FileExists(SignatureFlag) = False Or OutlookSignatureVersion = "000" Then
If objFSO.FolderExists(SignaturePath & "OutlookSignature_files") = True Then objFSO.DeleteFolder SignaturePath & "OutlookSignature_files" End If
If objFSO.FileExists(SignaturePath & "OutlookSignature.htm") = True Then objFSO.DeleteFile SignaturePath & "OutlookSignature.htm" End If
If objFSO.FileExists(SignaturePath & "OutlookSignature.txt") = True Then objFSO.DeleteFile SignaturePath & "OutlookSignature.txt" End If
If objFSO.FileExists(SignaturePath & "OutlookSignature.rtf") = True Then objFSO.DeleteFile SignaturePath & "OutlookSignature.rtf" End If
If objFSO.FolderExists(SignaturePath) = False Then objFSO.CreateFolder SignaturePath End If

If objFSO.FolderExists(SignaturePath & "OutlookSignature_files") = False Then
objFSO.CreateFolder SignaturePath & "OutlookSignature_files"
objFSO.CopyFile OutlookSignatureRemPath & "OutlookSignature.txt", SignaturePath & "OutlookSignature.txt.template"
objFSO.CopyFile OutlookSignatureRemPath & "OutlookSignature.htm", SignaturePath & "OutlookSignature.htm.template"
objFSO.CopyFile OutlookSignatureRemPath & "OutlookSignature_files\*", SignaturePath & "OutlookSignature_files\"
End If



' AD USER INFO
Set objSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
Set objUserMan = GetObject("LDAP://" & objUser.manager)
If objUser.givenName = "" Or IsNull(objUser.givenName) = True Then Sign_givenName = "" Else Sign_givenName = objUser.givenName End If
If objUser.initials = "" Or IsNull(objUser.initials) = True Then Sign_initials = "" Else Sign_initials = objUser.initials End If
If objUser.sn = "" Or IsNull(objUser.sn) = True Then Sign_sn = "" Else Sign_sn = objUser.sn End If
If objUser.displayName = "" Or IsNull(objUser.displayName) = True Then Sign_displayName = "" Else Sign_displayName = objUser.displayName End If
If objUser.description = "" Or IsNull(objUser.description) = True Then Sign_description = "" Else Sign_description = objUser.description End If
If objUser.physicalDeliveryOfficeName = "" Or IsNull(objUser.physicalDeliveryOfficeName) = True Then Sign_physicalDeliveryOfficeName = "" Else Sign_physicalDeliveryOfficeName = objUser.physicalDeliveryOfficeName End If
If objUser.telephoneNumber = "" Or IsNull(objUser.telephoneNumber) = True Then Sign_telephoneNumber = "" Else Sign_telephoneNumber = objUser.telephoneNumber End If
If objUser.otherTelephone = "" Or IsNull(objUser.otherTelephone) = True Then Sign_otherTelephone = "" Else Sign_otherTelephone = objUser.otherTelephone End If
If objUser.mail = "" Or IsNull(objUser.mail) = True Then Sign_mail = "" Else Sign_mail = objUser.mail End If
If objUser.wWWHomePage = "" Or IsNull(objUser.wWWHomePage) = True Then Sign_wWWHomePage = "" Else Sign_wWWHomePage = objUser.wWWHomePage End If
If objUser.url = "" Or IsNull(objUser.url) = True Then Sign_url = "" Else Sign_url = objUser.url End If
If objUser.streetAddress = "" Or IsNull(objUser.streetAddress) = True Then Sign_streetAddress = "" Else Sign_streetAddress = objUser.streetAddress End If
If objUser.postOfficeBox = "" Or IsNull(objUser.postOfficeBox) = True Then Sign_postOfficeBox = "" Else Sign_postOfficeBox = objUser.postOfficeBox End If
If objUser.l = "" Or IsNull(objUser.l) = True Then Sign_l = "" Else Sign_l = objUser.l End If
If objUser.st = "" Or IsNull(objUser.st) = True Then Sign_st = "" Else Sign_st = objUser.st End If
If objUser.postalCode = "" Or IsNull(objUser.postalCode) = True Then Sign_postalCode = "" Else Sign_postalCode = objUser.postalCode End If
If objUser.countryCode = "" Or IsNull(objUser.countryCode) = True Then Sign_countryCode = "" Else Sign_countryCode = objUser.countryCode End If
If objUser.homePhone = "" Or IsNull(objUser.homePhone) = True Then Sign_homePhone = "" Else Sign_homePhone = objUser.homePhone End If
If objUser.otherHomePhone = "" Or IsNull(objUser.otherHomePhone) = True Then Sign_otherHomePhone = "" Else Sign_otherHomePhone = objUser.otherHomePhone End If
If objUser.pager = "" Or IsNull(objUser.pager) = True Then Sign_pager = "" Else Sign_pager = objUser.pager End If
If objUser.otherPager = "" Or IsNull(objUser.otherPager) = True Then Sign_otherPager = "" Else Sign_otherPager = objUser.otherPager End If
If objUser.mobile = "" Or IsNull(objUser.mobile) = True Then Sign_mobile = "" Else Sign_mobile = objUser.mobile End If
If objUser.otherMobile = "" Or IsNull(objUser.otherMobile) = True Then Sign_otherMobile = "" Else Sign_otherMobile = objUser.otherMobile End If
If objUser.facsimileTelephoneNumber = "" Or IsNull(objUser.facsimileTelephoneNumber) = True Then Sign_facsimileTelephoneNumber = "" Else Sign_facsimileTelephoneNumber = objUser.facsimileTelephoneNumber End If
If objUser.otherFacsimileTelephoneNumber = "" Or IsNull(objUser.otherFacsimileTelephoneNumber) = True Then Sign_otherFacsimileTelephoneNumber = "" Else Sign_otherFacsimileTelephoneNumber = objUser.otherFacsimileTelephoneNumber End If
If objUser.ipPhone = "" Or IsNull(objUser.ipPhone) = True Then Sign_ipPhone = "" Else Sign_ipPhone = objUser.ipPhone End If
If objUser.otherIpPhone = "" Or IsNull(objUser.otherIpPhone) = True Then Sign_otherIpPhone = "" Else Sign_otherIpPhone = objUser.otherIpPhone End If
If objUser.info = "" Or IsNull(objUser.info) = True Then Sign_info = "" Else Sign_info = objUser.info End If
If objUser.title = "" Or IsNull(objUser.title) = True Then Sign_title = "" Else Sign_title = objUser.title End If
If objUser.department = "" Or IsNull(objUser.department) = True Then Sign_department = "" Else Sign_department = objUser.department End If
If objUser.company = "" Or IsNull(objUser.company) = True Then Sign_company = "" Else Sign_company = objUser.company End If
If objUser.manager = "" Or IsNull(objUser.manager) = True Then Sign_manager = "" Else Sign_manager = objUserMan.givenName & " " & objUserMan.sn End If



' TXT SIGNATURE
Set objTextFile = objFSO.OpenTextFile(SignaturePath & "OutlookSignature.txt.template", 1, False, -2)
Set objFile = objFSO.CreateTextFile(SignaturePath & "OutlookSignature.txt", True)
objFile.Close
Set objFile = objFSO.OpenTextFile(SignaturePath & "OutlookSignature.txt", 2)
Do while NOT objTextFile.AtEndOfStream
Inputline000 = objTextFile.ReadLine
Outputline01 = Replace(Inputline000,"###FIRSTNAME###",Sign_givenName)
Outputline02 = Replace(Outputline01,"###INITIALS###",Sign_initials)
Outputline03 = Replace(Outputline02,"###LASTNAME###",Sign_sn)
Outputline04 = Replace(Outputline03,"###DISPLAYNAME###",Sign_displayName)
Outputline05 = Replace(Outputline04,"###DESCRIPTION###",Sign_description)
Outputline06 = Replace(Outputline05,"###OFFICENAME###",Sign_physicalDeliveryOfficeName)
Outputline07 = Replace(Outputline06,"###TELEPHONE###",Sign_telephoneNumber)
Outputline08 = Replace(Outputline07,"###OTHERTELEPHONE###",Sign_otherTelephone)
Outputline09 = Replace(Outputline08,"###EMAIL###",Sign_mail)
Outputline10 = Replace(Outputline09,"###WEBPAGE###",Sign_wWWHomePage)
Outputline11 = Replace(Outputline10,"###OTHERWEBPAGE###",Sign_url)
Outputline12 = Replace(Outputline11,"###STREETADDRESS###",Sign_streetAddress)
Outputline13 = Replace(Outputline12,"###POSTOFFICEBOX###",Sign_postOfficeBox)
Outputline14 = Replace(Outputline13,"###CITY###",Sign_l)
Outputline15 = Replace(Outputline14,"###STATE###",Sign_st)
Outputline16 = Replace(Outputline15,"###POSTALCODE###",Sign_postalCode)
Outputline17 = Replace(Outputline16,"###COUNTRYCODE###",Sign_countryCode)
Outputline18 = Replace(Outputline17,"###HOMEPHONE###",Sign_homePhone)
Outputline19 = Replace(Outputline18,"###OTHERHOMEPHONE###",Sign_otherHomePhone)
Outputline20 = Replace(Outputline19,"###PAGER###",Sign_pager)
Outputline21 = Replace(Outputline20,"###OTHERPAGER###",Sign_otherPager)
Outputline22 = Replace(Outputline21,"###MOBILEPHONE###",Sign_mobile)
Outputline23 = Replace(Outputline22,"###OTHERMOBILEPHONE###",Sign_otherMobile)
Outputline24 = Replace(Outputline23,"###FAX###",Sign_facsimileTelephoneNumber)
Outputline25 = Replace(Outputline24,"###OTHERFAX###",Sign_otherFacsimileTelephoneNumber)
Outputline26 = Replace(Outputline25,"###IPPHONE###",Sign_ipPhone)
Outputline27 = Replace(Outputline26,"###OTHERIPPHONE###",Sign_otherIpPhone)
Outputline28 = Replace(Outputline27,"###NOTES###",Sign_info)
Outputline29 = Replace(Outputline28,"###JOBTITLE###",Sign_title)
Outputline30 = Replace(Outputline29,"###DEPARTMENT###",Sign_department)
Outputline31 = Replace(Outputline30,"###COMPANY###",Sign_company)
Outputline32 = Replace(Outputline31,"###MANAGER###",Sign_manager)
objFile.Write Trim(Outputline32) & vbCrLf
Loop
objFile.Close
objTextFile.Close
Set objTextFile = Nothing



' HTM SIGNATURE
Set objTextFile = objFSO.OpenTextFile(SignaturePath & "OutlookSignature.htm.template", 1, False, -2)
Set objFile = objFSO.CreateTextFile(SignaturePath & "OutlookSignature.htm", True)
objFile.Close
Set objFile = objFSO.OpenTextFile(SignaturePath & "OutlookSignature.htm", 2)
Do while NOT objTextFile.AtEndOfStream
Inputline000 = objTextFile.ReadLine
Outputline01 = Replace(Inputline000,"###FIRSTNAME###",Sign_givenName)
Outputline02 = Replace(Outputline01,"###INITIALS###",Sign_initials)
Outputline03 = Replace(Outputline02,"###LASTNAME###",Sign_sn)
Outputline04 = Replace(Outputline03,"###DISPLAYNAME###",Sign_displayName)
Outputline05 = Replace(Outputline04,"###DESCRIPTION###",Sign_description)
Outputline06 = Replace(Outputline05,"###OFFICENAME###",Sign_physicalDeliveryOfficeName)
Outputline07 = Replace(Outputline06,"###TELEPHONE###",Sign_telephoneNumber)
Outputline08 = Replace(Outputline07,"###OTHERTELEPHONE###",Sign_otherTelephone)
Outputline09 = Replace(Outputline08,"###EMAIL###",Sign_mail)
Outputline10 = Replace(Outputline09,"###WEBPAGE###",Sign_wWWHomePage)
Outputline11 = Replace(Outputline10,"###OTHERWEBPAGE###",Sign_url)
Outputline12 = Replace(Outputline11,"###STREETADDRESS###",Sign_streetAddress)
Outputline13 = Replace(Outputline12,"###POSTOFFICEBOX###",Sign_postOfficeBox)
Outputline14 = Replace(Outputline13,"###CITY###",Sign_l)
Outputline15 = Replace(Outputline14,"###STATE###",Sign_st)
Outputline16 = Replace(Outputline15,"###POSTALCODE###",Sign_postalCode)
Outputline17 = Replace(Outputline16,"###COUNTRYCODE###",Sign_countryCode)
Outputline18 = Replace(Outputline17,"###HOMEPHONE###",Sign_homePhone)
Outputline19 = Replace(Outputline18,"###OTHERHOMEPHONE###",Sign_otherHomePhone)
Outputline20 = Replace(Outputline19,"###PAGER###",Sign_pager)
Outputline21 = Replace(Outputline20,"###OTHERPAGER###",Sign_otherPager)
Outputline22 = Replace(Outputline21,"###MOBILEPHONE###",Sign_mobile)
Outputline23 = Replace(Outputline22,"###OTHERMOBILEPHONE###",Sign_otherMobile)
Outputline24 = Replace(Outputline23,"###FAX###",Sign_facsimileTelephoneNumber)
Outputline25 = Replace(Outputline24,"###OTHERFAX###",Sign_otherFacsimileTelephoneNumber)
Outputline26 = Replace(Outputline25,"###IPPHONE###",Sign_ipPhone)
Outputline27 = Replace(Outputline26,"###OTHERIPPHONE###",Sign_otherIpPhone)
Outputline28 = Replace(Outputline27,"###NOTES###",Sign_info)
Outputline29 = Replace(Outputline28,"###JOBTITLE###",Sign_title)
Outputline30 = Replace(Outputline29,"###DEPARTMENT###",Sign_department)
Outputline31 = Replace(Outputline30,"###COMPANY###",Sign_company)
Outputline32 = Replace(Outputline31,"###MANAGER###",Sign_manager)
objFile.Write Trim(Outputline32) & vbCrLf
Loop
objFile.Close
objTextFile.Close
Set objTextFile = Nothing



' REMOVE TEMPORARY FILES
If objFSO.FileExists(SignaturePath & "OutlookSignature.htm.template") = True Then objFSO.DeleteFile SignaturePath & "OutlookSignature.htm.template" End If
If objFSO.FileExists(SignaturePath & "OutlookSignature.txt.template") = True Then objFSO.DeleteFile SignaturePath & "OutlookSignature.txt.template" End If



' AUTOMATIC ACTIVATION
If objFSO.FileExists(SignaturePath & "OutlookSignature.txt") Then
keyPath = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
if objRegistry.EnumKey(&H80000001, keyPath, valueNames1) = 0 then
	if isArray(valueNames1) then
		for i1 = 0 to UBound(valueNames1)
		if objRegistry.EnumKey(&H80000001, keyPath & "\" & valueNames1(i1), valueNames2) = 0 then
			if isArray(valueNames2) then
				for i2 = 0 to UBound(valueNames2)
					if objRegistry.EnumKey(&H80000001, keyPath & "\" & valueNames1(i1) & "\" & valueNames2(i2), valueNames3) = 0 then
						if isArray(valueNames3) then
							for i3 = 0 to UBound(valueNames3)
							If InStr(valueNames3(i3),"0000") > 0 Then
							If OutlookSignatureFirsNew = 1 Then objRegistry.SetBinaryValue &H80000001, keyPath & "\" & valueNames1(i1) & "\" & valueNames2(i2) & "\" & valueNames3(i3), "New Signature", OutlookSignatureBinName End If
							If OutlookSignatureFirsRep = 1 Then objRegistry.SetBinaryValue &H80000001, keyPath & "\" & valueNames1(i1) & "\" & valueNames2(i2) & "\" & valueNames3(i3), "Reply-Forward Signature", OutlookSignatureBinName End If
							SetRegCounter = SetRegCounter + 1
							End If
					next
					end if
				end if
			next
			end if
		end if
	next
	end if
end if
keyPath = "Software\Microsoft\Office"
if objRegistry.EnumKey(&H80000001, keyPath, valueNames1) = 0 then
	if isArray(valueNames1) then
		for i1 = 0 to UBound(valueNames1)
		if objRegistry.EnumKey(&H80000001, keyPath & "\" & valueNames1(i1) & "\Outlook\Profiles", valueNames2) = 0 then
			if isArray(valueNames2) then
				for i2 = 0 to UBound(valueNames2)
					if objRegistry.EnumKey(&H80000001, keyPath & "\" & valueNames1(i1) & "\Outlook\Profiles\" & valueNames2(i2), valueNames3) = 0 then
						if isArray(valueNames3) then
							for i3 = 0 to UBound(valueNames3)
							if objRegistry.EnumKey(&H80000001, keyPath & "\" & valueNames1(i1) & "\Outlook\Profiles\" & valueNames2(i2) & "\" & valueNames3(i3), valueNames4) = 0 then
								if isArray(valueNames4) then
									for i4 = 0 to UBound(valueNames4)
									If InStr(valueNames4(i4),"0000") > 0 Then
									If OutlookSignatureFirsNew = 1 Then objRegistry.SetBinaryValue &H80000001, keyPath & "\" & valueNames1(i1) & "\Outlook\Profiles\" & valueNames2(i2) & "\" & valueNames3(i3) & "\" & valueNames4(i4), "New Signature", OutlookSignatureBinName End If
									If OutlookSignatureFirsRep = 1 Then objRegistry.SetBinaryValue &H80000001, keyPath & "\" & valueNames1(i1) & "\Outlook\Profiles\" & valueNames2(i2) & "\" & valueNames3(i3) & "\" & valueNames4(i4), "Reply-Forward Signature", OutlookSignatureBinName End If
									SetRegCounter = SetRegCounter + 1
									End If
							next
							end if
						end if
					next
					end if
				end if
			next
			end if
		end if
		objRegistry.DeleteValue &H80000001, keyPath & "\" & valueNames1(i1) & "\Outlook\Setup", "First-Run"
	next
	end if
end if
Set objFile = objFSO.CreateTextFile(SignatureFrst, True)
objFile.Close
Else
If objFSO.FolderExists(SignaturePath & "OutlookSignature_files") = True Then objFSO.DeleteFolder SignaturePath & "OutlookSignature_files" End If
If objFSO.FileExists(SignaturePath & "OutlookSignature.htm") = True Then objFSO.DeleteFile SignaturePath & "OutlookSignature.htm" End If
If objFSO.FileExists(SignaturePath & "OutlookSignature.txt") = True Then objFSO.DeleteFile SignaturePath & "OutlookSignature.txt" End If
If objFSO.FileExists(SignaturePath & "OutlookSignature.rtf") = True Then objFSO.DeleteFile SignaturePath & "OutlookSignature.rtf" End If
End If

End If



' FORCE RE-ACTIVATION
If objFSO.FileExists(SignatureFrst) = True Or objFSO.FileExists(SignatureFlag) = True Then
WScript.Sleep 60000
keyPath = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
if objRegistry.EnumKey(&H80000001, keyPath, valueNames1) = 0 then
	if isArray(valueNames1) then
		for i1 = 0 to UBound(valueNames1)
		if objRegistry.EnumKey(&H80000001, keyPath & "\" & valueNames1(i1), valueNames2) = 0 then
			if isArray(valueNames2) then
				for i2 = 0 to UBound(valueNames2)
					if objRegistry.EnumKey(&H80000001, keyPath & "\" & valueNames1(i1) & "\" & valueNames2(i2), valueNames3) = 0 then
						if isArray(valueNames3) then
							for i3 = 0 to UBound(valueNames3)
							If InStr(valueNames3(i3),"0000") > 0 Then
							If (OutlookSignatureFirsNew = 1 And OutlookSignatureRefrNew = 1) Or objFSO.FileExists(SignatureFrst) = True Then objRegistry.SetBinaryValue &H80000001, keyPath & "\" & valueNames1(i1) & "\" & valueNames2(i2) & "\" & valueNames3(i3), "New Signature", OutlookSignatureBinName End If
							If (OutlookSignatureFirsRep = 1 And OutlookSignatureRefrRep = 1) Or objFSO.FileExists(SignatureFrst) = True Then objRegistry.SetBinaryValue &H80000001, keyPath & "\" & valueNames1(i1) & "\" & valueNames2(i2) & "\" & valueNames3(i3), "Reply-Forward Signature", OutlookSignatureBinName End If
							SetRegCounter = SetRegCounter + 1
							End If
					next
					end if
				end if
			next
			end if
		end if
	next
	end if
end if
keyPath = "Software\Microsoft\Office"
if objRegistry.EnumKey(&H80000001, keyPath, valueNames1) = 0 then
	if isArray(valueNames1) then
		for i1 = 0 to UBound(valueNames1)
		if objRegistry.EnumKey(&H80000001, keyPath & "\" & valueNames1(i1) & "\Outlook\Profiles", valueNames2) = 0 then
			if isArray(valueNames2) then
				for i2 = 0 to UBound(valueNames2)
					if objRegistry.EnumKey(&H80000001, keyPath & "\" & valueNames1(i1) & "\Outlook\Profiles\" & valueNames2(i2), valueNames3) = 0 then
						if isArray(valueNames3) then
							for i3 = 0 to UBound(valueNames3)
							if objRegistry.EnumKey(&H80000001, keyPath & "\" & valueNames1(i1) & "\Outlook\Profiles\" & valueNames2(i2) & "\" & valueNames3(i3), valueNames4) = 0 then
								if isArray(valueNames4) then
									for i4 = 0 to UBound(valueNames4)
									If InStr(valueNames4(i4),"0000") > 0 Then
									If (OutlookSignatureFirsNew = 1 And OutlookSignatureRefrNew = 1) Or objFSO.FileExists(SignatureFrst) = True Then objRegistry.SetBinaryValue &H80000001, keyPath & "\" & valueNames1(i1) & "\Outlook\Profiles\" & valueNames2(i2) & "\" & valueNames3(i3) & "\" & valueNames4(i4), "New Signature", OutlookSignatureBinName End If
									If (OutlookSignatureFirsRep = 1 And OutlookSignatureRefrRep = 1) Or objFSO.FileExists(SignatureFrst) = True Then objRegistry.SetBinaryValue &H80000001, keyPath & "\" & valueNames1(i1) & "\Outlook\Profiles\" & valueNames2(i2) & "\" & valueNames3(i3) & "\" & valueNames4(i4), "Reply-Forward Signature", OutlookSignatureBinName End If
									SetRegCounter = SetRegCounter + 1
									End If
							next
							end if
						end if
					next
					end if
				end if
			next
			end if
		end if
		If OutlookSignatureRefrNew = 1 Or OutlookSignatureRefrRep = 1 Or objFSO.FileExists(SignatureFrst) = True Then objRegistry.DeleteValue &H80000001, keyPath & "\" & valueNames1(i1) & "\Outlook\Setup", "First-Run" End If
	next
	end if
end if
End If



' END
If objFSO.FileExists(SignatureFrst) = True Then objFSO.DeleteFile SignatureFrst End If
If SetRegCounter > 0 Then Set objFile = objFSO.CreateTextFile(SignatureFlag, True) End If
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
Set objUser = Nothing
Set objSysInfo = Nothing
Set oShell = Nothing

Tested on the following Microsoft OS versions:

• Microsoft Windows XP (32bit)
• Microsoft Windows 7 (32bit)

ClearCachedProfile_v1.0.vbs

' ##############################################################################
' #                                Lupi Gabriel                                #
' #                             www.lupigabriel.it                             #
' #                            info@lupigabriel.it                             #
' ##############################################################################
' #            Copyright (c) 2014 Lupi Gabriel All rights reserved.            #
' ##############################################################################
' # VERSION    : 1.0                                                           #
' # FILE       : ClearCachedProfile.vbs                                        #
' # CLASS      : Script                                                        #
' # LANGUAGE   : VB Script                                                     #
' # LOG FILE   : "%SystemRoot%\ClearCachedProfile.log"                         #
' ##############################################################################



On Error Resume Next



ClearNormalMonths = 12 ' #### CLEAR USER PROFILE CACHE AFTER * MONTHS
ClearMandatoryWeeks = 1 ' #### CLEAR MANDATORY USER PROFILE CACHE AFTER * WEEKS



Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set wshShell = CreateObject("WScript.Shell")

LogFilePath = wshShell.ExpandEnvironmentStrings("%SystemRoot%") & "\ClearCachedProfile.log"
If objFSO.FileExists(LogFilePath) = True Then
Set f = objFSO.GetFile(LogFilePath)
If DateDiff("m",f.DateLastModified,Now()) > 1 Then objFSO.DeleteFile LogFilePath End If
End If
Set objFile = objFSO.OpenTextFile(LogFilePath, 8, True)


if objRegistry.EnumKey(&H80000002, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList", valueNames1) = 0 then
	if isArray(valueNames1) then
		for i1 = 0 to UBound(valueNames1)
		LocalNTuser = ""
		LocalSID = valueNames1(i1)
		objRegistry.GetStringValue &H80000002, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\" & LocalSID, "Guid", GuidValue
		objRegistry.GetStringValue &H80000002, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\" & LocalSID, "ProfileImagePath", PathValue

		If InStr(LocalSID,"S-1-5-21-137065001-") > 0 Then

			Set objAccount = objWMIService.Get("Win32_SID.SID='" & Split(LocalSID,".",-1,1)(0) & "'")
				
			IsMandatory = ""
			If objFSO.FileExists(Trim(PathValue) & "\ntuser.man") = True Then
			LocalNTuser = Trim(PathValue) & "\ntuser.man"
			IsMandatory = "ON"
			End If
			If objFSO.FileExists(Trim(PathValue) & "\ntuser.dat") = True Then
			LocalNTuser = Trim(PathValue) & "\ntuser.dat"
			IsMandatory = "OFF"
			End If
				
			SpuriousProfile = "No"
			If objFSO.FolderExists(Trim(PathValue)) = False Then
			SpuriousProfile = "Yes"
			End If
				
			LastLogonW = 0
			LastLogonM = 0
			If IsMandatory <> "" Then
			Set f = objFSO.GetFile(LocalNTuser)
			LastLogonW = DateDiff("w",f.DateLastModified,Now())
			LastLogonM = DateDiff("m",f.DateLastModified,Now())
			Set f = Nothing
			End If
				
				
				
				
			ClearProfile = 0
			If IsMandatory = "ON" And LastLogonW > ClearMandatoryWeeks Then ClearProfile = 1 End If
			If IsMandatory = "OFF" And LastLogonM > ClearNormalMonths Then ClearProfile = 1 End If
			If SpuriousProfile = "Yes" Then ClearProfile = 1 End If
				
				

			Wscript.Echo
			Wscript.Echo "Path = " & Trim(PathValue)
			Wscript.Echo "SID = " & LocalSID
			Wscript.Echo "GUID = " & GuidValue
			Wscript.Echo "Mandatory = " & IsMandatory
			Wscript.Echo "LastLogon = " & LastLogonW & " Weeks - " & LastLogonM & " Months"
			Wscript.Echo "Spurious Profile = " & SpuriousProfile
			Wscript.Echo "IS DELETABLE = " & ClearProfile
				
			If ClearProfile = 1 Then
			objRegistry.DeleteKey &H80000002, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\" & LocalSID & "\Preference"
			objRegistry.DeleteKey &H80000002, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\" & LocalSID
			objRegistry.DeleteKey &H80000002, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileGuid\" & GuidValue
			objRegistry.DeleteKey &H80000002, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\PolicyGuid\" & GuidValue
			If objFSO.FolderExists(Trim(PathValue)) = True Then wshShell.run "ccp.bat """ & Trim(PathValue) & "\""",1,1 End If
			End If
				
				

			If ClearProfile = 1 Then
			objFile.WriteLine ""
			objFile.WriteLine ""
			objFile.WriteLine ""
			objFile.WriteLine Now()
			objFile.WriteLine ""
			objFile.WriteLine "Path = " & Trim(PathValue)
			objFile.WriteLine "SID = " & LocalSID
			objFile.WriteLine "GUID = " & GuidValue
			objFile.WriteLine "Mandatory = " & IsMandatory
			objFile.WriteLine "LastLogon = " & LastLogonW & " Weeks - " & LastLogonM & " Months"
			objFile.WriteLine "Spurious Profile = " & SpuriousProfile
			objFile.WriteLine ""
			objFile.WriteLine "=================================================="
			End If

		End If

		Set objAccount = Nothing
		next
	end if
end if

objFile.Close
Set objAccount = Nothing
Set objRegistry = Nothing
Set objWMIService = Nothing
Set objFSO = Nothing
Set wshShell = Nothing
Set objFile = Nothing
Set f = Nothing


'end script ClearCachedProfile