[Script] VBS para monitorar o tamanho das psts dos usuários
Enviado: 18 Jul 2013 01:08
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:
Exemplo do email enviado pelo script
Bom proveito
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 IfBom proveito