Lightweight VBScript Backup, with Email Reporting

Download source - 4.9 KB

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.

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)

About the Author

xExTxCx

United States

Member

No Biography provided

Article Top

Poor

Excellent

Add a reason or comment to your vote: x
Votes of 3 or less require a comment

Comments and Discussions

You must Sign In to use this message board.

Search this forum
	Profile popups Spacing Noise Layout Per page

Thanks much for this script. It's very good. I have a question though. How can I make it only backup the previous day's files and folders? Any assistance is appreciated. Thanks
Sign In·View Thread·Permalink


Sign In·View Thread·Permalink

I created a modified version and I think everyone can benefit from it

Major changes include a more scheduled task launch that does not use an IE object
Also I added a field to backup a database

MSSQL:servername:NorthWind

I hope it helps people.

#dbsettings.config
#####################################
#   Dated Backup Classic(c) v.1.5   #
#                                   #
#   Author: Brian Velde             #
#           brian@antidesign.us     #
#   Modified by: Joseph P. Cohen    #
############################################################################
# DIRECTIONS:                                                              #
#                                                                          #
# Enter folders to backup, one per line.                                   #
# Enclose complete path to each folder in quotes.                          #
# The destination folder name MUST be specified in the manner noted below. #
# (e.g "&lt;path_to_folder>";&lt;dest_folder_name>) - no spaces, UNC path OK.    #
# Configure backup specific options below.                                 #
############################################################################
# 
@ TARGET_DIRECTORY_FOR_BACKUPS = \\servername\c$\$backup_files$
@ TARGET_LOG_FILE_DIR = c:\$backup_files$\logs
@ MAX_PERCENT_OF_FREE_SPACE = 20
@ DAYS_TO_KEEP_BACKUPS = 10
 
#####################################
#   E-Mail settings.  *OPTIONAL*    #
#####################################
 
# yes or no
@ ENABLE_EMAIL_REPORTING = yes
@ EMAIL_TITLE = BUSDM-SALUDB BACKUP
@ EMAIL_ADDRESS_FOR_REPORTING = email@server.com
@ SENDING_EMAIL_ADDRESS = email@server.com
@ SMTP_SERVER_NAME = smtp.server.com
@ SMTP_SERVER_PORT = 25
@ SMTP_SERVER_USE_AUTHENTICATION = no
@ SMTP_SERVER_USERNAME = username
@ SMTP_SERVER_PASSWORD = password
@ SMTP_SERVER_USE_SSL = yes
 
#####################################
#  Enter folders to backup below..  #
#####################################
 
#"c:\DELL";DELL
#"c:\remote";Remote
"c:\Dev-Cpp";Dev-Cpp
#MSSQL:servername:NorthWind
#MSSQL:ServerName2:NorkhWind2

'DatedBackup.vbs
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
Dim logFile
Dim strEmailTitle
 
appName = "DatedBackup"
version = "2.0"
totSize = 0
 
' Added SQL backup support - Joseph P. Cohen

 
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 And Not fldr.Name = "logs" Then ' # is Days   should be >
	   		fldr.Delete
	   	End If
    Next 
End Function
 
Sub setstrDate()
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)
	strTime = Time()
	strTime = Replace(strTime,":","")
	strTime = Replace(strTime," ","")
	
	strDate = strYear & strMonth & strDay & "-" & strTime
End Sub
 

Function createFolder()
	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
			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
 
'checked-joe
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
								
							Else
								wscript.echo "Failed to create backup folder! Exiting..."
								WScript.Quit(666)
							End If
						'Else
							'writeToLog "Aborting..."
							'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,15) = "@ EMAIL_TITLE =" Then 
					ol = Len(tmp) 
					strEmailTitle = Right(tmp,(ol-15))
					strEmailTitle = Trim(strEmailTitle)	
				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
		
			If Left(arrSelect(x),6) = "MSSQL:" then
			
				' remove the header part and read the rest
				tempStr = Right(arrSelect(x),Len(arrSelect(x))-InStr(arrSelect(x),":"))
				
				strDBServerName = left(tempStr,InStr(tempStr,":")-1)
								
				strDB = Right(tempStr,Len(tempStr) - InStr(2,tempStr,":"))
				
				strTargetFolder = parentPath & "\" & strDate & "\" & strDBServerName & "_" & strDB
		
				backupMSSQLserver strDBServerName, strDB, strTargetFolder
		
			Else If Left(arrSelect(x),6) = "MYSQL:" then
			
				' remove the header part and read the rest
				tempStr = Right(arrSelect(x),Len(arrSelect(x))-InStr(arrSelect(x),":"))
				
				strDBServerName = left(tempStr,InStr(tempStr,":")-1)
								
				strDB = Right(tempStr,Len(tempStr) - InStr(2,tempStr,":"))
				
				strTargetFolder = parentPath & "\" & strDate & "\" & strDBServerName & "_" & strDB
		
				backupMYSQLserver strDBServerName, strDB, strTargetFolder
			
			
			else
			
				'this is the default action
				strTarget = arrSelect(x)
				ol = Len(strTarget)
				dlm = InStr(strTarget,";")
				nm = ol - dlm
				fldrName = Trim(Right(strTarget,nm))
				strTarget = Trim(Left(strTarget,(dlm-1)))
				strBkUp = "xcopy /s /c /d /e /h /i /r /k /y "
				
				'writeToLog "Backing up to: " & strTarget & " " & parentPath & "\" & strDate & "\" & fldrName & "\"
				
				strCommand = strBkUp & strTarget & " " & Chr(34) & parentPath & "\" & strDate & "\" & fldrName & "\" & Chr(34)
				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
				writeToLog  "Backing up folder: " & strTarget & " - " & sze & " MB"
				runBkup = sh.run("%comspec% /c" & strCommand,0,True) ' 0-hide the window(s),  True-Copy one folder at a time
				End if
			End If 'if sql
		End If
	Next
End Function
 

Function backupMSSQLserver(strDBServerName, strDB, strTargetFolder)
	'Joseph P. Cohen
	'extern strDate, writeToLog
	On Error Resume next
	
	writeToLog "Backing up MSSQL at: " & vbcrlf & _
				" Server = " & strDBServerName & vbcrlf & _
				" Database = " & strDB & vbcrlf & _
				" Target File = " & strTargetFolder & "_backup_" & strDate & ".bak'"
	
	strBAKcmd = "backup database " & strDB & " to disk = " & "'" & strTargetFolder & "_backup_" & strDate & ".bak'" & " with init"
	
	Set oConn = CreateObject("ADODB.Connection") 
	StrConnect = "Driver={SQL Server};Server=" & strDBServerName & ";"
	
	Err.Clear
	oConn.Open StrConnect
 
	If Not Err.Number = 0 Then
		writeToLog "Connect = Error: Can not connect to server " & Err.Number & " " & Err.Description
	Else
		writeToLog  "Connected to Server running backup command..."
		Set oRS = CreateObject("ADODB.Recordset")
		oConn.CommandTimeout = 0
		oRS.Open strBAKcmd, oConn
		
		If Not Err.Number = 0 Then
			writeToLog "Error running backup command " & Err.Number & " " & Err.Source & " " & Err.Description
		Else
			writeToLog  "Backup command sent..."
		End if	
	End if
	On Error Goto 0
End Function 		
 
Function backupMYSQLserver(strDBServerName, strDB, strTargetFolder)
 
	WScript.Echo "this function does not work"
	WScript.Quit(000)'
	'Joseph P. Cohen... this function is GOOD ENOUGH .. more time should be spent here.
	'extern strDate, writeToLog
	On Error Resume next
	
	writeToLog "Backing up MSSQL at: " & vbcrlf & _
				" Server = " & strDBServerName & vbcrlf & _
				" Database = " & strDB & vbcrlf & _
				" Target File = " & strTargetFolder & "_backup_" & strDate & ".bak'"
	
	strBAKcmd = "backup database " & strDB & " to disk = " & "'" & strTargetFolder & "_backup_" & strDate & ".bak'" & " with init"
	
	Set oConn = CreateObject("ADODB.Connection") 
	StrConnect = "Driver={MySQL ODBC 3.51 Driver};Server=" & strDBServerName & ";User=root;"
	
	Err.Clear
	oConn.Open StrConnect
 
	If Not Err.Number = 0 Then
		writeToLog "Connect = Error: Can not connect to server " & Err.Number & " " & Err.Description
	Else
		writeToLog  "Connected to Server running backup command..."
		Set oRS = CreateObject("ADODB.Recordset")
		oRS.Open strBAKcmd, oConn
		
		If Not Err.Number = 0 Then
			writeToLog "Error running backup command " & Err.Number & " " & Err.Source & " " & Err.Description
		Else
			writeToLog  "Backup command sent..."
		End if	
	End if
	On Error Goto 0
End Function 	
 

Function sendMail()
	
	Dim fso, logf
	Set fso = CreateObject("scripting.filesystemobject")
 
	'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
	
	
	If InStr(fso.OpenTextFile(logPath & "\backup" & strDate & ".txt",1).ReadAll(),"Error") = 0 Then
		objMessage.Subject = strEmailTitle & " completed successfully on " & strDate & "."
	Else
		objMessage.Subject = strEmailTitle & " HAD ERRORS!! " & strDate & "."
		objMessage.Fields("urn:schemas:httpmail:importance").Value = 2 
	End If
	
	
	objMessage.From = strSendingEmail
	objMessage.To = strReportEmail
	
 
	objMessage.HTMLBody = Replace(fso.OpenTextFile(logPath & "\backup" & strDate & ".txt",1).ReadAll(),vbCrLf,"<br>")
	'objMessage.AddAttachment = logPath & "\backup" & strDate & ".html"
	objMessage.Send
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:")
        	
    	
    	
    	
    	If Left(parentPath,2) = "\\" Then
	    	' Network Drive, we need the root share name
	    	Dim temp
	    	temp = InStr(parentPath,"\")
	    	temp = InStr(temp+1, parentPath,"\")
	    	temp = InStr(temp+1, parentPath,"\")
	    	temp = InStr(temp+1, parentPath,"\")
	    	
	    	tgtDrive = Left(parentPath, temp-1)
    	Else
	    	' local drive, we need root letter
	    	tgtDrive = Left(parentPath,1) 'find target drive letter
    	End if	
    		
    	Dim fso
    	Set fso = CreateObject("scripting.filesystemobject")
    	
    	'This change allows the lookup of SMB drives
    	Set objLogicalDisk = fso.GetDrive(tgtDrive)
    	
		absFree = objLogicalDisk.FreeSpace
    	parSize = objParent.Size
    	curSize = cur.Size
    	
    	If curSize = 0 Then
    		writeToLog "Error: Did not back up anything!!!"
    	else    	
    	
    	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)
		backups = free / curSize
		backups = FormatNumber(backups,0)
		backups = Int(backups)
		fldrDays = Int(fldrDays)
		
		writeToLog"You can perform " & backups & " backups before drive " & strPercent & "% full!"
		If (backups < fldrDays) Then
			writeToLog  "ERROR in c:\$backup$\dbsettings.config!"
			writeToLog  "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
			writeToLog  "You have enough disk space remaining for " & backups & " more backups."
		End If
		End If ' test for curSize if 0
	Else
	WScript.Echo "Error: Cannot Find Folder!  Did the backup run?"
    End If
End Function
 

 
Sub writeToLog(str)
	' var is logFile
	If IsEmpty(logFile) Then
		Set fso = CreateObject("Scripting.FileSystemObject")
	    Set rf = fso.GetFolder(parentPath)
	    If Not fso.FolderExists(logPath) Then
	    	fso.CreateFolder(logPath)
	    End If
	    Set lf = fso.GetFolder(logPath)
	    'ol = Len(strDate)
	    'strDate = Right(strDate,ol-1)
	    Set logFile = lf.CreateTextFile("backup" & strDate & ".txt",True)
	    writeToLog "=============================================="
	    writeToLog "Dated Backup Classic(c) v.1.5"
	    writeToLog "Original code Brian Velde <brian@antidesign.us>"
	    writeToLog "Modified by Joseph P. Cohen"
	    writeToLog "Backup log for " & strDate & ""
	End If
 
	logFile.write str & vbcrlf
 
End Sub
 

startTime = Timer()
setstrDate()
 

If Not readSelections() = 0 Then
	set sh = CreateObject("wscript.Shell")
	sh.LogEvent 1,"Error: Backup Failed! - Incorrect Selection File Syntax!"
	msgbox "Error: Backup Failed! - Incorrect Selection File Syntax!"
	WScript.Quit(1)
End If
 

	writeToLog "Backup Started at: " & Date() & " " & Time()
	writeToLog "Reading backup selections..."
	writeToLog "Cleaning up old files..."
 
If not cleanOld() = 0 Then
	set sh = CreateObject("wscript.Shell")
	sh.LogEvent 1,"Error: Backup Failed! - Unable to Remove Old Backup Folders!"
	writeToLog "Error: Backup Failed! - Unable to Remove Old Backup Folders!"
	WScript.Quit(1)
End If
 
	writeToLog  "Creating destination folder..."
 
If not createFolder() = 0 Then
	set sh = CreateObject("wscript.Shell")
	sh.LogEvent 1,"Error: Backup Failed! - Unable To Create Destination Folder!"
	writeToLog "Error: Backup Failed! - Unable To Create Destination Folder!"
	WScript.Quit(1)
End If
 
	writeToLog "Starting backup..."
 
If Not backup() = 0 Then
	set sh = CreateObject("wscript.Shell")
	sh.LogEvent 1,"Backup Failed! - Errors Encountered During the Backup Process!"
	writeToLog  "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
	writeToLog  "Backup Completed at: " & Date() & " " & Time() & " - " & FormatNumber(totSize,2) & " MB" & vbcrlf & "Elapsed Time: " & totTime & " " & count
Call auditDays()
 

	logFile.Close()
  If strUseEmailReporting = "yes" Then
    	Call sendMail()
  End If
  
	If curSize = 0 Then
		WScript.Quit(1)
	End if   
 
WScript.Quit(0)

Great edit! I have taken your edit and added Zip support. You have to have the 7zip command line utility in the same directory as the script and you no longer have to specify the path to the config file.

The package with 7zip can be downloaded HERE.[^]

dbsettings.config

#####################################
#   Dated Backup Classic(c) v.1.5   #
#                                   #
#   Author: Brian Velde             #
#           brian@antidesign.us     #
#   Modified by: Joseph P. Cohen    #
#   Modified by: Neal T. Bailey     #
############################################################################
# DIRECTIONS:                                                              #
#                                                                          #
# Enter folders to backup, one per line.                                   #
# Enclose complete path to each folder in quotes.                          #
# The destination folder name MUST be specified in the manner noted below. #
# ( e.g "<path_to_folder>";<dest_folder_name> ) - no spaces    #
# Configure backup specific options below.                                 #
############################################################################
# 
@ TARGET_DIRECTORY_FOR_BACKUPS = \\baileyfs01\Files\Uploads\backup
@ TARGET_LOG_FILE_DIR = c:\backup
@ MAX_PERCENT_OF_FREE_SPACE = 20
@ DAYS_TO_KEEP_BACKUPS = 10
@ CREATE_ZIP_ARCHIVE = yes
 
#####################################
#   E-Mail settings.  *OPTIONAL*    #
#####################################
 
# yes or no
@ ENABLE_EMAIL_REPORTING = no
@ EMAIL_TITLE = BUSDM-SALUDB BACKUP
@ EMAIL_ADDRESS_FOR_REPORTING = email@server.com
@ SENDING_EMAIL_ADDRESS = email@server.com
@ SMTP_SERVER_NAME = smtp.server.com
@ SMTP_SERVER_PORT = 25
@ SMTP_SERVER_USE_AUTHENTICATION = no
@ SMTP_SERVER_USERNAME = username
@ SMTP_SERVER_PASSWORD = password
@ SMTP_SERVER_USE_SSL = yes
 
#####################################
#  Enter folders to backup below..  #
#####################################
 
#"c:\DELL";DELL
#"c:\remote";Remote
"C:\Inetpub\wwwroot\music\App_Data";mp3cms-db
#MSSQL:servername:NorthWind
#MSSQL:ServerName2:NorkhWind2

datedBackup.vbs

Dim selectionFile
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
Dim logFile
Dim strEmailTitle
Dim strCreateZip
 
appName = "DatedBackup"
version = "2.0"
totSize = 0
 
' Added SQL backup support - Joseph P. Cohen
' Added Zip backup support - Neal T. Bailey

 
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 And Not fldr.Name = "logs" Then ' # is Days   should be >
	   		fldr.Delete
	   	End If
    Next 
End Function
 

 
Sub setstrDate()
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)
	strTime = Time()
	strTime = Replace(strTime,":","")
	strTime = Replace(strTime," ","")
	
	strDate = strYear & strMonth & strDay & "-" & strTime
End Sub
 
'Neal Bailey: 06/27/09
Function getWorkingDirectory()
 
	aScriptFilename = Split(Wscript.ScriptFullName, "\")
 	sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
 	sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
	getWorkingDirectory = sWorkingDirectory
 
End Function
 
'Neal Bailey: 06/27/09
Function Zip(sFolder,sArchiveName)
  
	Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
  	Set oShell = WScript.CreateObject("Wscript.Shell")
 
	sWorkingDirectory = getWorkingDirectory
 	If oFSO.FileExists(sWorkingDirectory & "\" & "7za.exe") Then
    		s7zLocation = ""
  	ElseIf oFSO.FileExists("C:\Program Files\7-Zip\7za.exe") Then
    		s7zLocation = "C:\Program Files\7-Zip\"
  	Else
    		writeToLog("Error: Couldn't find 7za.exe")
    		Exit Function
  	End If
  
	oShell.Run """" & s7zLocation & "7za.exe"" a -tzip -y """ & sArchiveName & """ " & sFolder, 0, True
	
	If oFSO.FileExists(sArchiveName) Then
    		Zip = 0
  	Else
		Zip = 1
  	End If
End Function
 

Function createFolder()
	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
			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
 
'checked-joe
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, 22) = "@ CREATE_ZIP_ARCHIVE =" Then
					ol = Len(tmp)
					strCreateZip = Right(tmp,(ol-22))
					strCreateZip = Trim(strCreateZip)
					strCreateZip = LCase(strCreateZip)
				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
								
							Else
								wscript.echo "Failed to create backup folder! Exiting..."
								WScript.Quit(666)
							End If
						'Else
							'writeToLog "Aborting..."
							'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,15) = "@ EMAIL_TITLE =" Then 
					ol = Len(tmp) 
					strEmailTitle = Right(tmp,(ol-15))
					strEmailTitle = Trim(strEmailTitle)	
				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
		
			If Left(arrSelect(x),6) = "MSSQL:" then
			
				' remove the header part and read the rest
				tempStr = Right(arrSelect(x),Len(arrSelect(x))-InStr(arrSelect(x),":"))				
				strDBServerName = left(tempStr,InStr(tempStr,":")-1)								
				strDB = Right(tempStr,Len(tempStr) - InStr(2,tempStr,":"))				
				strTargetFolder = parentPath & "\" & strDate & "\" & strDBServerName & "_" & strDB		
				backupMSSQLserver strDBServerName, strDB, strTargetFolder
		
			Else If Left(arrSelect(x),6) = "MYSQL:" then
			
				' remove the header part and read the rest
				tempStr = Right(arrSelect(x),Len(arrSelect(x))-InStr(arrSelect(x),":"))				
				strDBServerName = left(tempStr,InStr(tempStr,":")-1)								
				strDB = Right(tempStr,Len(tempStr) - InStr(2,tempStr,":"))				
				strTargetFolder = parentPath & "\" & strDate & "\" & strDBServerName & "_" & strDB		
				backupMYSQLserver strDBServerName, strDB, strTargetFolder			
			
			else
			
				'this is the default action
				strTarget = arrSelect(x)
				ol = Len(strTarget)
				dlm = InStr(strTarget,";")
				nm = ol - dlm
				fldrName = Trim(Right(strTarget,nm))
				strTarget = Trim(Left(strTarget,(dlm-1)))
				strBkUp = "xcopy /s /c /d /e /h /i /r /k /y "
				
				'writeToLog "Backing up to: " & strTarget & " " & parentPath & "\" & strDate & "\" & fldrName & "\"
				
				strCommand = strBkUp & strTarget & " " & Chr(34) & parentPath & "\" & strDate & "\" & fldrName & "\" & Chr(34)
				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
 
				'Neal Bailey
				If strCreateZip = "yes" THEN
					writeToLog "Creating archive: " & parentPath & "\" & strDate & "\" & fldrName & "\" & strDate & ".zip"
				    	runBkup = Zip(strTarget, parentPath & "\" & strDate & "\" & fldrName & "\" & strDate & ".zip")
					
				Else
					writeToLog  "Backing up folder: " & strTarget & " - " & sze & " MB"
					runBkup = sh.run("%comspec% /c" & strCommand,0,True) ' 0-hide the window(s),  True-Copy one folder at a time
				End If
 
			End if
			End If 'if sql
		End If
	Next
End Function
 
Function backupMSSQLserver(strDBServerName, strDB, strTargetFolder)
	'Joseph P. Cohen
	'extern strDate, writeToLog
	On Error Resume next
	
	writeToLog "Backing up MSSQL at: " & vbcrlf & _
				" Server = " & strDBServerName & vbcrlf & _
				" Database = " & strDB & vbcrlf & _
				" Target File = " & strTargetFolder & "_backup_" & strDate & ".bak'"
	
	strBAKcmd = "backup database " & strDB & " to disk = " & "'" & strTargetFolder & "_backup_" & strDate & ".bak'" & " with init"
	
	Set oConn = CreateObject("ADODB.Connection") 
	StrConnect = "Driver={SQL Server};Server=" & strDBServerName & ";"
	
	Err.Clear
	oConn.Open StrConnect
 
	If Not Err.Number = 0 Then
		writeToLog "Connect = Error: Can not connect to server " & Err.Number & " " & Err.Description
	Else
		writeToLog  "Connected to Server running backup command..."
		Set oRS = CreateObject("ADODB.Recordset")
		oConn.CommandTimeout = 0
		oRS.Open strBAKcmd, oConn
		
		If Not Err.Number = 0 Then
			writeToLog "Error running backup command " & Err.Number & " " & Err.Source & " " & Err.Description
		Else
			writeToLog  "Backup command sent..."
		End if	
	End if
	On Error Goto 0
End Function 		
 
Function backupMYSQLserver(strDBServerName, strDB, strTargetFolder)
 
	WScript.Echo "this function does not work"
	WScript.Quit(000)'
	'Joseph P. Cohen... this function is GOOD ENOUGH .. more time should be spent here.
	'extern strDate, writeToLog
	On Error Resume next
	
	writeToLog "Backing up MSSQL at: " & vbcrlf & _
				" Server = " & strDBServerName & vbcrlf & _
				" Database = " & strDB & vbcrlf & _
				" Target File = " & strTargetFolder & "_backup_" & strDate & ".bak'"
	
	strBAKcmd = "backup database " & strDB & " to disk = " & "'" & strTargetFolder & "_backup_" & strDate & ".bak'" & " with init"
	
	Set oConn = CreateObject("ADODB.Connection") 
	StrConnect = "Driver={MySQL ODBC 3.51 Driver};Server=" & strDBServerName & ";User=root;"
	
	Err.Clear
	oConn.Open StrConnect
 
	If Not Err.Number = 0 Then
		writeToLog "Connect = Error: Can not connect to server " & Err.Number & " " & Err.Description
	Else
		writeToLog  "Connected to Server running backup command..."
		Set oRS = CreateObject("ADODB.Recordset")
		oRS.Open strBAKcmd, oConn
		
		If Not Err.Number = 0 Then
			writeToLog "Error running backup command " & Err.Number & " " & Err.Source & " " & Err.Description
		Else
			writeToLog  "Backup command sent..."
		End if	
	End if
	On Error Goto 0
End Function 	
 

Function sendMail()
	
	Dim fso, logf
	Set fso = CreateObject("scripting.filesystemobject")
 
	'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
	
	
	If InStr(fso.OpenTextFile(logPath & "\backup" & strDate & ".txt",1).ReadAll(),"Error") = 0 Then
		objMessage.Subject = strEmailTitle & " completed successfully on " & strDate & "."
	Else
		objMessage.Subject = strEmailTitle & " HAD ERRORS!! " & strDate & "."
		objMessage.Fields("urn:schemas:httpmail:importance").Value = 2 
	End If
	
	
	objMessage.From = strSendingEmail
	objMessage.To = strReportEmail
	
 
	objMessage.HTMLBody = Replace(fso.OpenTextFile(logPath & "\backup" & strDate & ".txt",1).ReadAll(),vbCrLf,"<br>")
	'objMessage.AddAttachment = logPath & "\backup" & strDate & ".html"
	objMessage.Send
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:")   	
    	
    	If Left(parentPath,2) = "\\" Then
	    	' Network Drive, we need the root share name
	    	Dim temp
	    	temp = InStr(parentPath,"\")
	    	temp = InStr(temp+1, parentPath,"\")
	    	temp = InStr(temp+1, parentPath,"\")
	    	temp = InStr(temp+1, parentPath,"\")
	    	
	    	tgtDrive = Left(parentPath, temp-1)
    	Else
	    	' local drive, we need root letter
	    	tgtDrive = Left(parentPath,1) 'find target drive letter
    	End if	
    		
    	Dim fso
    	Set fso = CreateObject("scripting.filesystemobject")
    	
    	'This change allows the lookup of SMB drives
    	Set objLogicalDisk = fso.GetDrive(tgtDrive)
    	
		absFree = objLogicalDisk.FreeSpace
    	parSize = objParent.Size
    	curSize = cur.Size
    	
    	If curSize = 0 Then
    		writeToLog "Error: Did not back up anything!!!"
    	else    	
    	
    	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)
		backups = free / curSize
		backups = FormatNumber(backups,0)
		backups = Int(backups)
		fldrDays = Int(fldrDays)
		
		writeToLog"You can perform " & backups & " backups before drive " & strPercent & "% full!"
		If (backups < fldrDays) Then
			writeToLog  "ERROR in c:\$backup$\dbsettings.config!"
			writeToLog  "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
			writeToLog  "You have enough disk space remaining for " & backups & " more backups."
		End If
		End If ' test for curSize if 0
	Else
	WScript.Echo "Error: Cannot Find Folder!  Did the backup run?"
    End If
End Function
 
Sub writeToLog(str)
	' var is logFile
	If IsEmpty(logFile) Then
		Set fso = CreateObject("Scripting.FileSystemObject")
	    Set rf = fso.GetFolder(parentPath)
	    If Not fso.FolderExists(logPath) Then
	    	fso.CreateFolder(logPath)
	    End If
	    Set lf = fso.GetFolder(logPath)
	    'ol = Len(strDate)
	    'strDate = Right(strDate,ol-1)
	    Set logFile = lf.CreateTextFile("backup" & strDate & ".txt",True)
	    writeToLog "=============================================="
	    writeToLog "Dated Backup Classic(c) v.1.5"
	    writeToLog "Original code Brian Velde <brian@antidesign.us>"
	    writeToLog ""
	    writeToLog "Modified by Joseph P. Cohen"
	    writeToLog "Modified by Neal T. Bailey <nealbailey@hotmail.com>"
	    writeToLog "=============================================="
	    writeToLog ""
	    writeToLog "Backup log for " & strDate & ""
	End If
 
	logFile.write str & vbcrlf
End Sub
 
'** Main() **

selectionFile = getWorkingDirectory & "\" & "dbsettings.config"
startTime = Timer()
setstrDate()
 
If Not readSelections() = 0 Then
	set sh = CreateObject("wscript.Shell")
	sh.LogEvent 1,"Error: Backup Failed! - Incorrect Selection File Syntax!"
	msgbox "Error: Backup Failed! - Incorrect Selection File Syntax!"
	WScript.Quit(1)
End If
 
	writeToLog "Backup Started at: " & Date() & " " & Time()
	writeToLog "Reading backup selections..."
	writeToLog "Cleaning up old files..."
 
If not cleanOld() = 0 Then
	set sh = CreateObject("wscript.Shell")
	sh.LogEvent 1,"Error: Backup Failed! - Unable to Remove Old Backup Folders!"
	writeToLog "Error: Backup Failed! - Unable to Remove Old Backup Folders!"
	WScript.Quit(1)
End If
 
	writeToLog  "Creating destination folder..."
 
If not createFolder() = 0 Then
	set sh = CreateObject("wscript.Shell")
	sh.LogEvent 1,"Error: Backup Failed! - Unable To Create Destination Folder!"
	writeToLog "Error: Backup Failed! - Unable To Create Destination Folder!"
	WScript.Quit(1)
End If
 
	writeToLog "Starting backup..."
 
If Not backup() = 0 Then
	set sh = CreateObject("wscript.Shell")
	sh.LogEvent 1,"Backup Failed! - Errors Encountered During the Backup Process!"
	writeToLog  "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
	writeToLog  "Backup Completed at: " & Date() & " " & Time() & " - " & FormatNumber(totSize,2) & " MB" & vbcrlf & "Elapsed Time: " & totTime & " " & count
 
If NOT strCreateZip = "yes" Then
	Call auditDays() 'this isn't working in Zip mode
End If
 
	logFile.Close()
  If strUseEmailReporting = "yes" Then
    	Call sendMail()
  End If
  
	If curSize = 0 Then
		WScript.Quit(1)
	End if   
 
WScript.Quit(0)

This is a very useful script! Does a lot of things that I have not been able to figure out in the past with vbscript. Generally I end up writing a program to do most of this work. Thanks for the contribution.
Sign In·View Thread·Permalink

sides_dale wrote:
This is a very useful script! Does a lot of things that I have not been able to figure out in the past with vbscript. Generally I end up writing a program to do most of this work. Thanks for the contribution.

Thanks!

I wrote it initially to serve as a ghetto backup program for clients that won't pay for Veritas.

In the version that I use, I packaged it with XYNTService, (another utility found on code project) so that the script can be run as a service. I package the whole thing using PrimalScript so that everything can be distributed via an EXE. If you like leveraging the power of VBScript in Windows, I also have an installer framework that can be found here.

Brian