[Script] VBS para monitorar o tamanho das psts dos usuários

[marceloleaes]

Este script tem como finalidade verificar os arquivos pst configurados nos Outlooks dos usuários e enviar um email para o Administrador avisando quando os mesmos excederem o tamanho aceitavel máximo permitido. Para aumentar o tamanho, caso deseje ajuste maxFileSize = 1843 pelo valor em MB correspondente. Ajuste os campos responsaveis pelo envio de email personalizando a gosto, copie para o NETLOGON de seu servidor e após crie uma GPO deixando o script na inicialização dos computadores dos usuários. No logon, será verificado as psts e enviado email quando o tamanho exceder. Segue código do script:

Código: Selecionar todos

' =================================================================================================
' Script para monitoramento do tamanho dos arquivos PST dos usuários
' Por Marcelo Leães - [email protected]
' Use a vontade, mas mantenha os créditos ;)
' =================================================================================================
 
Dim maxFileSize
Dim OutputStr
Dim sendFrom
Dim sendTo
Dim sendSMTP
Dim sendUser
Dim sendPass
Dim sendPort
Dim useSSL

maxFileSize = 1843
sendFrom    = """Microsoft Outlook"" [email protected]"
sendTo      = "[email protected]"
sendSMTP    = "smtp.suaempresa.com.br"
sendUser    = "[email protected]"
sendPass    = "senhadousuário"
sendPort    = 587
useSSL      = false
 
Set WshShell = Wscript.CreateObject("WScript.Shell")
Set Envi = WshShell.Environment ("Process")
Set objFSO = createobject("Scripting.FileSystemObject")
Set shApp = CreateObject("Shell.application")
 
If objFSO.FolderExists(shApp.Namespace(&H1C&).Self.Path & "\Microsoft\Outlook") Then
 Set FolderPath = objFSO.GetFolder(shApp.Namespace(&H1C&).Self.Path & "\Microsoft\Outlook")
 For Each File in FolderPath.Files

If objFSO.GetExtensionName(File)="pst" Then
 If cint((File.size / 1024) / 1024) > maxFileSize Then
 OutputStr = OutputStr & File.name & " - Tamanho: " & cint((File.Size / 1024) / 1024) & "MB" & vbCrLf
 End If
End If

Next

If OutputStr <> "" Then

 Set WshNetwork = WScript.CreateObject("WScript.Network")
 Const cdoBasic = 1
 Set objMessage = CreateObject("CDO.Message")
 objMessage.Subject = WshNetwork.UserName & " em " & WshNetwork.ComputerName & " excedeu o limite do Outlook"
 objMessage.From = sendFrom
 objMessage.To = sendTo
 objMessage.TextBody = OutputStr

With objMessage.Configuration.Fields
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = sendSMTP
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = sendUser
 .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = sendPass
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = sendPort
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = useSSL
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
 .Update
End With

On Error Resume Next
 objMessage.Send
 End If
End If

Exemplo do email enviado pelo script



Bom proveito