with this script the backup is not working correctly, can someone find where is the problem? We have 15 computers in our network and with this script it is not going correctly. If someone can find the problem I’ll be grateful.
This is the script:
on error resume next
countup = 0
Const READFILE = 1 ' text file constants
const HTML = 0
const NORMAL = 1
Dim fso, f, ts, shell, foldersfound, foldersNOTfound, errormsg, foldersmade, oldFolders
dim author, recipient, subject, body, i, temp, fo
Set fso = CreateObject( "Scripting.FileSystemObject" )
Set f = fso.GetFile( "x:\backup.txt" )
Set ts = f.OpenAsTextStream( READFILE, false )
set shell = CreateObject("WScript.Shell")
Do While ( ts.AtEndOfLine <> True )
backupstring = ts.Readline
if NOT fso.FolderExists(backupstring) then
foldersNOTfound = foldersNOTfound & ", " & backupstring
end if
'msgbox str
countup = countup + 1
position1 = InStr(1, backupstring, "\")
position2 = InStr(1, backupstring, "$")
position3 = InStr(position2, backupstring, "\")
position4 = InStr(position3 + 1, backupstring, "\")
position5 = Instr(position4 +1, backupstring, "\")
position9 = Len(backupstring)
computername = Mid(backupstring, 3, position2 - position1 - 4)
lastfolder = mid(backupstring, position5, position9 - position5)
If position4 > 0 Then
folder_name = Mid(backupstring, position2 + 2, position4 - position3 - 1)
'MsgBox folder_name
End If
backuppath = backupstring
If position4 > 0 Then
directory_path = "x:\" & computername & "\" & folder_name & lastfolder & "\"
Else
directory_path = "x:\" & computername
End If
'MsgBox directory_path
directory1 = "x:\" & computername
if NOT fso.FolderExists(directory1) then
'foldersNOTfound = foldersNOTfound & ", " & directory1
'wscript.echo directory1
fso.CreateFolder(directory1)
'shell.run "MkDir " & directory1
else
'foldersfound = foldersfound & ", " & directory1
'Set fo = fso.GetFolder(directory1)
'if DateDiff("ww", fo.DateLastModified, Now()) >= 2 then
' oldFolders = oldFolder & ", " & directory1
'end if
'set fo = nothing
end if
if err.number <> 0 then
errormsg = errormsg & "; " & err.number & "--" & err.source & "--" & err.description
err.clear
end if
'UserName = Mid$(backupstring, position2 + 1, position3 - position2 - 1)
'MsgBox directory_path
if NOT fso.FolderExists(directory_path) then
'foldersNOTfound = foldersNOTfound & ", " & directory_path
'MsgBox checkone
'wscript.echo directory_path
'shell.run "MkDir " & directory_path
fso.CreateFolder(directory_path)
else
'Set fo = fso.GetFolder(directory_path)
'if DateDiff("ww", fo.DateLastModified, Now()) >= 2 then
' oldFolders = oldFolder & ", " & directory_path
'end if
'set fo = nothing
end if
if err.number <> 0 then
errormsg = errormsg & "; " & err.number & "--" & err.source & "--" & err.description
err.clear
end if
shell_send = "xcopy " & Chr(34) & backuppath & "*.*" & Chr(34) & " " & Chr(34) & directory_path & Chr(34) & " /s /y /c /d"
'msgbox backuppath
'msgbox directory_path
'msgbox lastfolder
shell.run shell_send
if err.number <> 0 then
errormsg = errormsg & "; " & err.number & "--" & err.source & "--" & err.description
err.clear
end if
Loop
ts.Close
Set ts = Nothing
Set f = Nothing
set fso = nothing
set shell = nothing
author = (e-mail address removed)
recipient = "(e-mail address removed); (e-mail address removed); (e-mail address removed); (e-mail address removed)"
'recipient = (e-mail address removed)
subject = "user backup generated email"
body = ""
'body = body & "Folders that are +2 weeks old"
'temp = split(oldFolders, ", ")
'if isArray(temp) then
' for i = 0 to ubound(temp)
' body = body & "
[size=-1]" & temp(i) & ""[/size]
' next ' i
'end if
'body = body & "
"
'body = body & "
"</FONT></FONT>
body = body & "Folders that DO NOT exist"temp = split(foldersNOTfound, ", ")
if isArray(temp) then
for i = 0 to ubound(temp)
body = body & "
[size=-1]" & temp(i) & ""[/size]
next ' i
end if
body = body & "
"
body = body & "
"</FONT></FONT>
body = body & "Errors"
temp = split(errormsg, "; ")
if isArray(temp) then
for i = 0 to ubound(temp)
body = body & "
[size=-1]" & temp(i) & ""[/size]
next ' i
end if
body = body & "
"
body = body & "
"</FONT></FONT>
Email author, recipient, "", subject, body, HTML, "", NORMAL
'---------------------------------------------------------------------------
' FUNCTION - Email
'-----------------------------------------------------------------------
' strAuthorEmail - The author of the email
' strRecipientEmail - The person that will receive the email
' strCC - Carbon Copy
' strSubject - Subject header
' strBody - Email content, message
' intMailFormat - Send the email as HTML or TEXT
' 0 - HTML
' 1 - TEXT
' strAttachmentPath - Send an attachment
' intPriority - Urgency of message
' 0 - Low
' 1 - Normal
' 2 - High
'------------------------------------------------------------------------------------------------------------------
' Use:
' Call Email("(e-mail address removed)", "(e-mail address removed)", "(e-mail address removed)", "RE: Hello.", "Hi, today was a good day.", HTML, ".../books.xls", Normal)
'--------------------------------------------------------------------------------------------------------------------
Private Sub Email(strAuthorEmail, strRecipientEmail, strCC, strSubject, strBody, intMailFormat, strAttachmentPath, intPriority)
Dim ObjMail
Set ObjMail = CreateObject("CDONTS.NewMail")
ObjMail.FROM = strAuthorEmail
ObjMail.TO = strRecipientEmail
If strCC <> "" Then
ObjMail.Cc = strCC
End If
ObjMail.Subject = strSubject
ObjMail.BodyFormat = intMailFormat
ObjMail.MailFormat = intMailFormat
ObjMail.Body = strBody
ObjMail.Importance = intPriority
If strAttachmentPath <> "" Then
ObjMail.AttachFile strAttachmentPath
End If
ObjMail.Send
Set ObjMail = Nothing
End Sub
Function alternateColor(n)
if (n mod 2 = 0) then
alternateColor = "#efefef"
else
alternateColor = "white"
end if
End Function
This is the script:
on error resume next
countup = 0
Const READFILE = 1 ' text file constants
const HTML = 0
const NORMAL = 1
Dim fso, f, ts, shell, foldersfound, foldersNOTfound, errormsg, foldersmade, oldFolders
dim author, recipient, subject, body, i, temp, fo
Set fso = CreateObject( "Scripting.FileSystemObject" )
Set f = fso.GetFile( "x:\backup.txt" )
Set ts = f.OpenAsTextStream( READFILE, false )
set shell = CreateObject("WScript.Shell")
Do While ( ts.AtEndOfLine <> True )
backupstring = ts.Readline
if NOT fso.FolderExists(backupstring) then
foldersNOTfound = foldersNOTfound & ", " & backupstring
end if
'msgbox str
countup = countup + 1
position1 = InStr(1, backupstring, "\")
position2 = InStr(1, backupstring, "$")
position3 = InStr(position2, backupstring, "\")
position4 = InStr(position3 + 1, backupstring, "\")
position5 = Instr(position4 +1, backupstring, "\")
position9 = Len(backupstring)
computername = Mid(backupstring, 3, position2 - position1 - 4)
lastfolder = mid(backupstring, position5, position9 - position5)
If position4 > 0 Then
folder_name = Mid(backupstring, position2 + 2, position4 - position3 - 1)
'MsgBox folder_name
End If
backuppath = backupstring
If position4 > 0 Then
directory_path = "x:\" & computername & "\" & folder_name & lastfolder & "\"
Else
directory_path = "x:\" & computername
End If
'MsgBox directory_path
directory1 = "x:\" & computername
if NOT fso.FolderExists(directory1) then
'foldersNOTfound = foldersNOTfound & ", " & directory1
'wscript.echo directory1
fso.CreateFolder(directory1)
'shell.run "MkDir " & directory1
else
'foldersfound = foldersfound & ", " & directory1
'Set fo = fso.GetFolder(directory1)
'if DateDiff("ww", fo.DateLastModified, Now()) >= 2 then
' oldFolders = oldFolder & ", " & directory1
'end if
'set fo = nothing
end if
if err.number <> 0 then
errormsg = errormsg & "; " & err.number & "--" & err.source & "--" & err.description
err.clear
end if
'UserName = Mid$(backupstring, position2 + 1, position3 - position2 - 1)
'MsgBox directory_path
if NOT fso.FolderExists(directory_path) then
'foldersNOTfound = foldersNOTfound & ", " & directory_path
'MsgBox checkone
'wscript.echo directory_path
'shell.run "MkDir " & directory_path
fso.CreateFolder(directory_path)
else
'Set fo = fso.GetFolder(directory_path)
'if DateDiff("ww", fo.DateLastModified, Now()) >= 2 then
' oldFolders = oldFolder & ", " & directory_path
'end if
'set fo = nothing
end if
if err.number <> 0 then
errormsg = errormsg & "; " & err.number & "--" & err.source & "--" & err.description
err.clear
end if
shell_send = "xcopy " & Chr(34) & backuppath & "*.*" & Chr(34) & " " & Chr(34) & directory_path & Chr(34) & " /s /y /c /d"
'msgbox backuppath
'msgbox directory_path
'msgbox lastfolder
shell.run shell_send
if err.number <> 0 then
errormsg = errormsg & "; " & err.number & "--" & err.source & "--" & err.description
err.clear
end if
Loop
ts.Close
Set ts = Nothing
Set f = Nothing
set fso = nothing
set shell = nothing
author = (e-mail address removed)
recipient = "(e-mail address removed); (e-mail address removed); (e-mail address removed); (e-mail address removed)"
'recipient = (e-mail address removed)
subject = "user backup generated email"
body = ""
'body = body & "Folders that are +2 weeks old"
'temp = split(oldFolders, ", ")
'if isArray(temp) then
' for i = 0 to ubound(temp)
' body = body & "
[size=-1]" & temp(i) & ""[/size]
' next ' i
'end if
'body = body & "
"
'body = body & "
"</FONT></FONT>
body = body & "Folders that DO NOT exist"temp = split(foldersNOTfound, ", ")
if isArray(temp) then
for i = 0 to ubound(temp)
body = body & "
[size=-1]" & temp(i) & ""[/size]
next ' i
end if
body = body & "
"
body = body & "
"</FONT></FONT>
body = body & "Errors"
temp = split(errormsg, "; ")
if isArray(temp) then
for i = 0 to ubound(temp)
body = body & "
[size=-1]" & temp(i) & ""[/size]
next ' i
end if
body = body & "
"
body = body & "
"</FONT></FONT>
Email author, recipient, "", subject, body, HTML, "", NORMAL
'---------------------------------------------------------------------------
' FUNCTION - Email
'-----------------------------------------------------------------------
' strAuthorEmail - The author of the email
' strRecipientEmail - The person that will receive the email
' strCC - Carbon Copy
' strSubject - Subject header
' strBody - Email content, message
' intMailFormat - Send the email as HTML or TEXT
' 0 - HTML
' 1 - TEXT
' strAttachmentPath - Send an attachment
' intPriority - Urgency of message
' 0 - Low
' 1 - Normal
' 2 - High
'------------------------------------------------------------------------------------------------------------------
' Use:
' Call Email("(e-mail address removed)", "(e-mail address removed)", "(e-mail address removed)", "RE: Hello.", "Hi, today was a good day.", HTML, ".../books.xls", Normal)
'--------------------------------------------------------------------------------------------------------------------
Private Sub Email(strAuthorEmail, strRecipientEmail, strCC, strSubject, strBody, intMailFormat, strAttachmentPath, intPriority)
Dim ObjMail
Set ObjMail = CreateObject("CDONTS.NewMail")
ObjMail.FROM = strAuthorEmail
ObjMail.TO = strRecipientEmail
If strCC <> "" Then
ObjMail.Cc = strCC
End If
ObjMail.Subject = strSubject
ObjMail.BodyFormat = intMailFormat
ObjMail.MailFormat = intMailFormat
ObjMail.Body = strBody
ObjMail.Importance = intPriority
If strAttachmentPath <> "" Then
ObjMail.AttachFile strAttachmentPath
End If
ObjMail.Send
Set ObjMail = Nothing
End Sub
Function alternateColor(n)
if (n mod 2 = 0) then
alternateColor = "#efefef"
else
alternateColor = "white"
end if
End Function