Link to home
Start Free TrialLog in
Avatar of mikeewalton
mikeewaltonFlag for United States of America

asked on

VBS Script to scan robocopy logs.

Ok guys I need something done with this script, and simply don't have the time to deal with it at the moment.  Currently the script below will scan a robocopy log, attach it to an email, and in the email body post rather it was successful or had errors......

What I would like for it to do, is basically the same thing, but I do not want it to attach the log unless it had errors.  So if it is successful, I simply want an email saying that it was successful, no log attached; if it failed, then I want to keep the error message in the subject line, and want it to attach the log......I would also like it to change the subject line, if it was successful then the subject should state Data Copy Successful, if it failed then Data Copy Unsuccessful, etc.

Thanks!
Dim txtSMTPServer, txtTo, txtFrom, txtSubject, txtBody
Dim txtLog, strValue, iTotal, iPos, strText
 
txtSMTPServer = "server.domain.local"	          'SMTP server
txtTo = "user@domain.com"		                  'To Address
txtFrom = "administrator@domain.com"                     'From Address
txtSubject = "Data Backup Status"            'Subject line
txtLog = "c:\robo.log" 'path to the
                                       'robocopy log file
 
'Get the file contents
FileContents = GetFile(txtLog)
 
'-- Cycle thru the log file to find errors --
 
strText = FileContents
iPos = 1
Do While iPos <= Len(strText)
   If InStr(iPos, UCase(strText), "0X00000") > 0 Then
       iTotal = iTotal + 1
            iPos = InStr(iPos, UCase(strText), "0X00000")_
            + Len("0X00000")
        Else
            Exit Do
        End If
Loop
 
'-- --
 
If iTotal > 0 Then
   strErrors = 1
Else
   strErrors = 0
End If
 
'Output something meaningful if we do or dont find failures
If strErrors = 1 Then
   txtBody = "DETECTED A FAILURE " & iTotal & " files " &_
   "appear to have failed in this job. See attached file."
Else
   txtBody = "ROBOCOPY SUCCESSFUL no errors seem to be " &_
   "present in this robocopy log. See attached file."
End If   
 
'-- Email Send --
Const cdoSendUsingMethod = _
"http://schemas.microsoft.com/cdo/configuration/sendusing", _
cdoSendUsingPort = 2, _
cdoSMTPServer = _
"http://schemas.microsoft.com/cdo/configuration/smtpserver"
'// Create CDO connections.
Dim iMsg, iConf, Flds
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
With Flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = txtSMTPServer
.Update
End With
'// Set the message properties.
With iMsg
Set .Configuration = iConf
.To = txtTo
.From = txtFrom
.Subject = txtSubject
.TextBody = txtBody
End With
if txtlog <> "" then iMsg.AddAttachment txtLog
'// Send the message.
iMsg.Send ' send the message.
 
'-- Readfile function --
function GetFile(txtLog)
  If txtLog<>"" Then
    Dim FS, FileStream
    Set FS = CreateObject("Scripting.FileSystemObject")
      on error resume Next
      Set FileStream = FS.OpenTextFile(txtLog)
      GetFile = FileStream.ReadAll
  End If
End Function

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of TakedaT
TakedaT
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial