Click here to Skip to main content
15,886,012 members
Search within:


Articles / Programming Languages / VBScript
 
Article

Lightweight VBScript Backup, with Email Reporting

Rate me:
Please Sign up or sign in to vote.
4.57/5 (9 votes)
21 Mar 2008CPOL 61.4K   817   31   6
Creates dated folders for backing up files/folders on a schedule. Removes backups older than n days. Configuration via text file.
Screenshot - dbsettings.png

Introduction

This is a simple backup utility that creates dated backup folders. Dated Backup will remove backups older than N days.

Using the Code

This is the datedBackup.vbs file. The editor mangled some of the responses that are to be written to the HTML log files. If you choose to use any of this code, please download the zip so that you can see it in its original format. As you can see from line 1, you must specify the path to the dbsettings.config file. Once you have done that, you must edit the dbsettings.config file to backup the folders that you choose. Dbsettings is also where you enable/disable features of the script such as email notification. Currently this script will check our website for newer versions of itself and download if you choose. Have fun!

Should you decide to use this script or if you like the concept, let me know.

VBScript
selectionFile = "c:\$BACKUP$\dbsettings.config"
Dim strDate
Dim i
Dim arrSelect(30)
Dim objExplorer
Dim totSize
Dim parentPath
Dim strPercent
Dim logPath
Dim startTime
Dim endTime 
Dim fldrDays
Dim strUseEmailReporting
Dim strReportEmail
Dim strSendingEmail
Dim strSmtpServer
Dim strSmtpPort
Dim strSmtpAuth
Dim strSmtpUser
Dim strSmtpPass
Dim strSmtpSsl, appName, version, installer

appName = "DatedBackup"
version = "1.5"
installer = "http://218netdownloads.apscc.org/veldeApps/datedBackup_install(v1.5).exe"

totSize = 0
strSendingEmail = "dated.backup@default_address.com"

Function isOld(appName, version, installer)
    Dim fso, list, objWinHttp, strHTML, objList, tmp, ol, getVersion, upgrade, ie2
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set list = fso.CreateTextFile("./§",True)
    Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
        objWinHttp.Open "GET", "http://218netdownloads.apscc.org/versions.txt"
        objWinHttp.Send
        objWinHttp.WaitforResponse(5000)
        strHTML = objWinHttp.ResponseText
        If strHTML = "" Then
            WScript.Echo "Unable to poll for updates..."
        End If 
        list.Write strHTML
        
    Set objlist = fso.OpenTextFile("./§")
    Do Until objList.AtEndOfStream
        tmp = objList.ReadLine    
        If Left(tmp,len(appName)) = appName Then
            ol = Len(tmp)
            getVersion = Right(tmp,(ol-Len(appName)-1))
            WScript.Echo getVersion
            If getVersion > version Then
                upgrade = MsgBox("The version of " & appName & _
		" you are using is out-dated." & VbCrLf & _
		"Do you wish to upgrade?",vbYesNo,"Upgrade Available")
                If upgrade = vbYes Then
                    Set ie2 = CreateObject("InternetExplorer.Application")
                        ie2.Navigate installer  
                    WScript.Quit(0)
                End If
            ElseIf getVersion < version Then
                WScript.Echo "The version of pushVNC that you have downloaded _
		is corrupt or otherwise f***ed with... Exiting!"
                WScript.Quit(1) 
            End If
        End If 
    Loop
    objList.Close
    Set objList = Nothing
    'fso.DeleteFile "./§", True
End Function


Function getParent()
    'INCORPORATED INTO readSelections() v.1.2
End Function

Function createWindow()
    Set objExplorer = CreateObject("InternetExplorer.Application")
    objExplorer.Navigate "about:blank"   
    objExplorer.ToolBar = 0
    objExplorer.StatusBar = 1
    objExplorer.Width = 800
    objExplorer.Height = 600 
    objExplorer.Visible = 1             
    objExplorer.Document.Title = "Backing Up data...          " 
    objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "

<ul>"
End Function

Function cleanOld()
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set rf = fso.GetFolder(parentPath)
    Set fsub = rf.SubFolders
    For Each fldr In fsub
           diff = Date() - fldr.DateLastModified
           If diff > fldrDays Then ' # is Days
               fldr.Delete
           End If
    Next 
End Function

Function createFolder()
    strDay = Day(Date)
    If Len(strDay) < 2 Then
        strDay = 0 & strDay
    End If
    strMonth = Month(Date)
    If Len(strMonth) < 2 Then
        strMonth = 0 & strMonth
    End If
    strYear = Year(Date)
    strDate = "\" & strYear & strMonth & strDay
    Set fso = CreateObject("scripting.filesystemobject")
    If fso.FolderExists(parentPath & strDate) Then
        intMsg = MsgBox("Backup appears to have already run.  _
		Run again?",vbYesNo,"Run backup again?")
        If intMsg = vbNo Then
            objExplorer.Quit()
            set sh = CreateObject("wscript.Shell")
            sh.LogEvent 1,"Backup Failed! - Canceled by user... _
				Destination Folder Exists..."
            WScript.Quit(2)
        End If
    Else
        fso.CreateFolder(parentPath & strDate)
    End If
End Function

Function readSelections()
    Set fso = CreateObject("scripting.filesystemobject")
    Set objlist = fso.OpenTextFile(selectionFile)
    i=0
    Do Until objList.AtEndOfStream
        tmp = objList.ReadLine    
        If Left(tmp,1) = "#" Or left(tmp,1) = "" Then 'find comments
        Else    
            If Left(tmp,1) = "@" Then
                If Left(tmp,23) = "@ TARGET_LOG_FILE_DIR =" Then
                    ol = Len(tmp)
                    logPath = Right(tmp,(ol-24))
                    logPath = Trim(logPath)
                ElseIf Left(tmp,24) = "@ DAYS_TO_KEEP_BACKUPS =" Then
                    ol = Len(tmp)
                    fldrDays = Right(tmp,(ol-25))
                    fldrDays = Trim(fldrDays)
                    fldrDays = Int(fldrDays)
                ElseIf Left(tmp,29) = "@ MAX_PERCENT_OF_FREE_SPACE =" Then
                    ol = Len(tmp)
                    strPercent = Right(tmp,ol-30)
                    strPercent = Trim(strPercent)
                    strPercent = Int(strPercent)
                ElseIf Left(tmp,32) = "@ TARGET_DIRECTORY_FOR_BACKUPS =" Then
                    ol = Len(tmp)
                    parentPath = Right(tmp,(ol-32))
                    parentPath = Trim(parentPath)
                    ol = Len(parentPath)
                    If Not fso.FolderExists(parentPath) = True Then
                        intMsg = MsgBox("Destination folder _
			(" & parentPath & ") does not exist!.  _
			Do you wish to create it?",vbYesNo,_
			"Create destination folder?")
                        If intMsg = vbYes Then
                            Set folder = fso.CreateFolder(parentPath)
                            If fso.FolderExists(parentPath) = True Then
                                intMsg = MsgBox("Backup folder created successfully!",_
					vbOKOnly,"Folder created!")
                            Else
                                intMsg = MsgBox("Failed to create backup folder! _
				Exiting...",vbOKOnly,"Folder not created!")
                                WScript.Quit(666)
                            End If
                        Else
                            intMsg = MsgBox("Aborting...",vbOKOnly,"Abort!")
                            WScript.Quit(333)
                        End If
                    End If
                ElseIf Left(tmp,31) = "@ EMAIL_ADDRESS_FOR_REPORTING =" Then
                    ol = Len(tmp)
                    strReportEmail = Right(tmp,(ol-31))
                    strReportEmail = Trim(strReportEmail)
                ElseIf Left(tmp,25) = "@ SENDING_EMAIL_ADDRESS =" Then 
                    ol = Len(tmp) 
                    strSendingEmail = Right(tmp,(ol-25))
                    strSendingEmail = Trim(strSendingEmail)
                ElseIf Left(tmp,20) = "@ SMTP_SERVER_NAME =" Then
                    ol = Len(tmp)
                    strSmtpServer = Right(tmp,(ol-20))
                    strSmtpServer = Trim(strSmtpServer)
                ElseIf Left(tmp,26) = "@ ENABLE_EMAIL_REPORTING =" Then
                    ol = Len(tmp) 
                    strUseEmailReporting = Right(tmp,(ol-26))
                    strUseEmailReporting = Trim(strUseEmailReporting)
                    strUseEmailReporting = LCase(strUseEmailReporting)
                ElseIf Left(tmp,20) = "@ SMTP_SERVER_PORT =" Then
                    ol = Len(tmp)
                    strSmtpPort = Right(tmp,(ol-20))
                    strSmtpPort = Trim(strSmtpPort)
                ElseIf Left(tmp,34) = "@ SMTP_SERVER_USE_AUTHENTICATION =" Then
                    ol = Len(tmp)
                    strSmtpAuth = Right(tmp,(ol-34))
                    strSmtpAuth = Trim(strSmtpAuth)
                    strSmtpAuth = LCase(strSmtpAuth)
                ElseIf Left(tmp,24) = "@ SMTP_SERVER_USERNAME =" Then
                    ol = Len(tmp)
                    strSmtpUser = Right(tmp,(ol-24))
                    strSmtpUser = Trim(strSmtpUser)
                ElseIf Left(tmp,24) = "@ SMTP_SERVER_PASSWORD =" Then
                    ol = Len(tmp)
                    strSmtpPass = Right(tmp,(ol-24))
                    strSmtpPass = Trim(strSmtpPass)
                ElseIf Left(tmp,23) = "@ SMTP_SERVER_USE_SSL =" Then
                    ol = Len(tmp)
                    strSmtpSsl = Right(tmp,(ol-23))
                    strSmtpSsl = Trim(strSmtpSsl)
                    strSmtpSsl = LCase(strSmtpSsl)
                End If
            Else
                arrSelect(i) = tmp
                i = i + 1    
            End If 'line starts with "@"
        End If ' line starts with "#" or " " 
    Loop
End Function

Function backup()
    set sh = CreateObject("wscript.Shell")
    For x=0 To (i-1)
        If Not arrSelect(x) = "" Then
            strTarget = arrSelect(x)
            ol = Len(strTarget)
            dlm = InStr(strTarget,";")
            nm = ol - dlm
            fldrName = Right(strTarget,nm)
            strTarget = Left(strTarget,(dlm-1))
            strBkUp = "xcopy /s /c /d /e /h /i /r /k /y "
            strCommand = strBkUp & strTarget & " " & parentPath & _
				strDate & "\" & fldrName & "\"
            Set fso = CreateObject("scripting.filesystemobject")
            tgtL = Len(strTarget)
            tgt = Right(strTarget,tgtL-1)
            tgtL = Len(tgt)
            tgt = Left(tgt,tgtL-1)
            Set f = fso.GetFolder(tgt)
            sze = f.Size
            sze = sze / 1024 / 1024 ' to MB
            sze = FormatNumber(sze,2) ' cut at 2 decimal place
            totSize = totSize + sze
            objExplorer.Document.Body.InnerHTML = _
		objExplorer.Document.Body.InnerHTML & "<li>Backing up folder: " _
		& strTarget & " - " & sze & " MB</li><title>Backup log for " _
		& strDate & "</title>"
            runBkup = sh.run("%comspec% /c" & _
	strCommand,0,True) ' 0-hide the window(s),  True-Copy one folder at a time
        End If
    Next
End Function

Function sendMail()
    'WScript.Echo logPath & "\backup" & strDate & ".html"
    Set objMessage = CreateObject("CDO.Message")
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/_
		cdo/configuration/sendusing") = 2 'use '1' for local SMTP
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/_
		cdo/configuration/smtpserver") = strSmtpServer
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/_
		cdo/configuration/smtpserverport") = strSmtpPort
    If strSmtpAuth = "yes" Then
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/_
	cdo/configuration/smtpauthenticate") = 1 'use '2' for NTLM authentication
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/_
	cdo/configuration/sendusername") = strSmtpUser
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/_
	cdo/configuration/sendpassword") = strSmtpPass
    End If
    If strSmtpSsl = "yes" Then
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/_
	cdo/configuration/smtpusessl") = True
    End If
    objMessage.Configuration.Fields.Update
    objMessage.Subject = "Dated Backup Report for " & strDate & "."
    objMessage.From = strSendingEmail
    objMessage.To = strReportEmail
    objMessage.HTMLBody = objExplorer.Document.Body.InnerHTML
    'objMessage.AddAttachment = logPath & "\backup" & strDate & ".html"
    objMessage.Send
End Function
    
Function createLog()
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set rf = fso.GetFolder(parentPath)
    If fso.FolderExists(logPath) Then
    Else
        Set clf = fso.CreateFolder(logPath)
    End If
    Set lf = fso.GetFolder(logPath)
    ol = Len(strDate)
    strDate = Right(strDate,ol-1)
    Set logFile = lf.CreateTextFile("backup" & strDate & ".html",True)
    logFile.write ""
    logFile.write objExplorer.Document.Body.InnerHTML & ""
    If strUseEmailReporting = "yes" Then
        Call sendMail()
    End If
End Function 

Function auditDays()
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(parentPath & strDate) Then
        Set cur = fso.GetFolder(parentPath & strDate)
        Set objParent = fso.GetFolder(parentPath)
        Set objWMIService = GetObject("winmgmts:")
        tgtDrive = Left(parentPath,1) 'find target drive letter
        Set objLogicalDisk = objWMIService.Get("Win32_LogicalDisk.DeviceID='" _
		& tgtDrive & ":'")
        absFree = objLogicalDisk.FreeSpace
        parSize = objParent.Size
        curSize = cur.Size
        curSize = curSize / 1024 / 1024 'MB
        curSize = FormatNumber(curSize,2)
        curSize = Int(curSize)
        'absolute free space
        free = absFree + parSize
        free = (free * (strPercent / 100))
        free = free / 1024 / 1024 'MB
        free = FormatNumber(free,0)
        'WScript.Echo "Drive c: " & free & " MB free!"
        'WScript.Echo "Size: " & curSize
        backups = free / curSize
        backups = FormatNumber(backups,0)
        backups = Int(backups)
        fldrDays = Int(fldrDays)
        'WScript.Echo "You can perform " & backups & " backups before drive 90% full!"
        If (backups < fldrDays) Then
            objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
		"<h1>ERROR in c:\$backup$\dbsettings.config!</h1>"
            objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
		"<h4>Value entered for DAYS_TO_KEEP_BACKUPS is invalid.  _
		Due to the space limitations" _
                	& "of your hard drive, DAYS_TO_KEEP_BACKUPS can be no more than '" _
		& backups & "' !      Please fix this."
        Else
            objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
		"</h4><h4>You have enough disk space remaining for " & backups & _
		" more backups.</h4>"
        End If
    Else
    WScript.Echo "Cannot Find Folder!  Did the backup run?"
    End If
End Function
Call isOld(appName, version, installer)
Call createWindow()
startTime = Timer()
    objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
		"</ul>Backup Started at: " & Date() & " " & Time() & "

"
    objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
		"<li>Reading backup selections...</li>"

If Not readSelections() = 0 Then
    set sh = CreateObject("wscript.Shell")
    sh.LogEvent 1,"Backup Failed! - Incorrect Selection File Syntax!"
    objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
		"<h2>Backup Failed! - Incorrect Selection File Syntax!</h2>"
    sh.Popup("Backup Failed! - Incorrect Selection File Syntax!")
    WScript.Quit(1)
End If

    objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
		"<li>Cleaning up old files...</li>"

If not cleanOld() = 0 Then
    set sh = CreateObject("wscript.Shell")
    sh.LogEvent 1,"Backup Failed! - Unable to Remove Old Backup Folders!"
    objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
	"<h2>Backup Failed! - Unable to Remove Old Backup Folders!</h2>"
    sh.Popup("Backup Failed! - Unable to Remove Old Backup Folders!")
    WScript.Quit(1)
End If

    objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
	"<li>Creating destination folder...</li>"

If not createFolder() = 0 Then
    set sh = CreateObject("wscript.Shell")
    sh.LogEvent 1,"Backup Failed! - Unable To Create Destination Folder!"
    objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
	"<h2>Backup Failed! - Unable To Create Destination Folder!</h2>"
    sh.Popup("Backup Failed! - Unable To Create Destination Folder!")
    WScript.Quit(1)
End If

    objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
	"<li>Starting backup...</li><ol>"

If Not backup() = 0 Then
    set sh = CreateObject("wscript.Shell")
    sh.LogEvent 1,"Backup Failed! - Errors Encountered During the Backup Process!"
    objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
	"<h2>Backup Failed! - Errors Encountered During the Backup Process!</h2>"
    sh.Popup("Backup Failed! - Errors Encountered During the Backup Process!")
    WScript.Quit(1)
End If
endTime = Timer()
totTime = endTime - startTime
If totTime < 60 Then
    totTime = FormatNumber(totTime,2)
    count = "seconds."
ElseIf totTime < 3600 Then
    totTime = totTime / 60
    totTime = FormatNumber(totTime,2)
    count = "minutes."
ElseIf totTime > 3600 Then
    totTime = totTime / 60 / 60
    totTime = FormatNumber(totTime,2)
    count = "hours."
End If
    objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
	"</ol>Backup Completed at: " & Date() & " " & Time() & " - " _
	& FormatNumber(totSize,2) & " MB
<h3>Elapsed Time: " & totTime & " " & count & "</h3>"
    objExplorer.Document.Title = "Backup Completed at: " & Date() & " " & Time() _
	& " - " & FormatNumber(totSize,2) & " MB "
Call auditDays()
Call createLog()
Set sh = CreateObject("wscript.Shell")
    sh.LogEvent 4,objExplorer.Document.Body.InnerHTML
WScript.Quit(0)

Points of Interest

Chop this baby into whatever you wish it to be. Just make sure that you either give credit or email me a thank you.

History

  • 5-17-07 - Version 1.5 uploaded

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
xExTxCx
United States United States
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.

Comments and Discussions

 
First Prev Next
GeneralRE: Lightweight VBScript Backup, with Email Reporting Pin
vlad228814-Mar-10 17:44
vlad228814-Mar-10 17:44 
GeneralReally a very very usefull one..... Pin
njoshi198712-Nov-09 22:54
njoshi198712-Nov-09 22:54 
GeneralModified Version Pin
IeEE80234-May-09 9:21
IeEE80234-May-09 9:21 
GeneralRe: Modified Version Pin
thund3rstruck27-Jun-09 17:02
thund3rstruck27-Jun-09 17:02 
GeneralNice Job Pin
sides_dale21-May-07 16:09
sides_dale21-May-07 16:09 
GeneralRe: Nice Job Pin
xExTxCx24-May-07 13:08
xExTxCx24-May-07 13:08 
Last Visit: 31-Dec-99 18:00     Last Update: 25-Apr-24 10:07Refresh1

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.

Permalink
Advertise
Privacy
Cookies
Terms of Use
Layout: fixed | fluid

Posted 17 May 2007

Article Copyright 2007 by xExTxCx
Everything else Copyright © CodeProject, 1999-2024

Web01 2.8:2024-04-02:1