VBScript for compressing files in a folder and send on FTP

This is a simple vbscript compression script. works flawlessly on text files even bigger than 15GB.
We have a SSIS data generation package installed on our DB server which generates huge data files for data mining operations for current year, current month. The below scripts are doing the rest; compress the files and FTP to the data mining server location.
 

'======================================================

' Function : Zip datamart CSV, CTL files to local server for archive purposes.

'======================================================

Function WindowsZip(sFile, sZipFile, szPath, szDate)

  Set oZipShell = CreateObject("WScript.Shell") 

  Set oZipFSO = CreateObject("Scripting.FileSystemObject")

  Set LogFile = oZipFSO.CreateTextFile(szPath & "\Logs\log_" & szDate & ".log", true) 

 LogFile.WriteLine("=======================================")

  LogFile.WriteLine(Now & " - Compressing CSV file - Starting...")

 LogFile.WriteLine("=======================================")

  If Not oZipFSO.FileExists(sZipFile) Then

    NewZip(sZipFile)

  End If

  Set oZipApp = CreateObject("Shell.Application")

  Set source = oZipApp.NameSpace(sFile).Items

  sZipFileCount = oZipApp.NameSpace(sZipFile).items.Count

oZipApp.NameSpace(sZipFile).Copyhere source

LogFile.WriteLine(sZipFile & " - Compressing -")

'Keep script waiting until Compressing is done

On Error Resume Next

sLoop = 0

Do Until sZipFileCount < oZipApp.NameSpace(sZipFile).Items.Count

 Wscript.Sleep(100)

 sLoop = sLoop + 1

Loop

On Error GoTo 0

  LogFile.WriteLine(sZipFile & " - Successfully compressed -")

  LogFile.WriteBlankLines 1

  LogFile.Close

  Set LogFile = Nothing

  Set oZipShell = Nothing

  Set oZipFSO = Nothing 

End Function

Sub NewZip(sNewZip)

  Set oNewZipFSO = CreateObject("Scripting.FileSystemObject")

  Set oNewZipFile = oNewZipFSO.CreateTextFile(sNewZip)

  oNewZipFile.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)

  oNewZipFile.Close

  Set oNewZipFSO = Nothing

  Wscript.Sleep(500)

End Sub

'======================================================

' Function : Upload datamart CSV, CTL files to MTMS FTP server.

'======================================================

Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath, szPath, szDate, szYear, szMonth)

  Const OpenAsDefault = -2

  Const FailIfNotExist = 0

  Const ForReading = 1

  Const ForWriting = 2

  Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")

  Set oFTPScriptShell = CreateObject("WScript.Shell")

  Set LogFile = oFTPScriptFSO.OpenTextFile(szPath & "\Logs\log_" & szDate & ".log", 8)  

LogFile.WriteLine("========================================")

  LogFile.WriteLine(Now & " - Sending CSV file on FTP - Starting...")

LogFile.WriteLine("========================================")

  sRemotePath = Trim(sRemotePath)

  sLocalFile = Trim(sLocalFile)  

  'Check to ensure that a remote path was

  'passed. If it's blank then pass a "\"

  If Len(sRemotePath) = 0 Then

    sRemotePath = "\"

  End If

  If InStr(sLocalFile, "*") Then

    If InStr(sLocalFile, " ") Then

      FTPUpload = "Error: Wildcard uploads do not work if the path contains a " & "space." & vbCRLF

      FTPUpload = FTPUpload & "This is a limitation of the Microsoft FTP client."

 LogFile.WriteLine(FTPUpload)

      Exit Function

    End If

  ElseIf Len(sLocalFile) = 0 Or Not oFTPScriptFSO.FileExists(sLocalFile) Then

    'nothing to upload

    FTPUpload = "Error: File Not Found."

LogFile.WriteLine(sLocalFile & FTPUpload)

    Exit Function

  End If

  '--------END Path Checks---------

  

  'build input file for ftp command

  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF

  sFTPScript = sFTPScript & sPassword & vbCRLF

  sFTPScript = sFTPScript & "prompt " & vbCRLF

  sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF

  sFTPScript = sFTPScript & "binary" & vbCRLF

  sFTPScript = sFTPScript & "lcd " & szPath & vbCRLF

  sFTPScript = sFTPScript & "mput " & sLocalFile & vbCRLF

  sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF

  sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")

  sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName

  sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName

  'Write the input file for the ftp command

  'to a temporary file.

  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)

  fFTPScript.WriteLine(sFTPScript)

  fFTPScript.Close

  Set fFTPScript = Nothing  

  oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & " > " & sFTPResults, 0, TRUE

  Wscript.Sleep 1000

  'Check results of transfer.

  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, FailIfNotExist, OpenAsDefault)

  'sResults = fFTPResults.ReadAll

  Do Until fFTPResults.AtEndOfStream

    sResults = sResults & vbCRLF & fFTPResults.ReadLine

  Loop

  fFTPResults.Close

  oFTPScriptFSO.DeleteFile(sFTPTempFile)

  oFTPScriptFSO.DeleteFile (sFTPResults)

  If InStr(sResults, "226 Transfer complete.") > 0 Then

    FTPUpload = "226 Transfer complete."

  ElseIf InStr(sResults, "File not found") > 0 Then

    FTPUpload = "Error: File Not Found"

  ElseIf InStr(sResults, "cannot log in.") > 0 Then

    FTPUpload = "Error: Login Failed."

  Else

    FTPUpload = sResults & "Error: Unknown."

  End If

  LogFile.WriteLine(FTPUpload)

  LogFile.WriteBlankLines 1

  LogFile.Close

  Set oFTPScriptFSO = Nothing

  Set oFTPScriptShell = Nothing

  Set LogFile = Nothing

End Function

Dim dtTemp, szMonth, szDayName, szDay, szYear, inFilename, outFilename, szPath, szDate

dtTemp = Date

'Get the 2 digit month. VBScript does not include a function for this

if (len(CStr(Month(dtTemp))) < 2) then

szMonth = "0" & CStr(Month(dtTemp))

else

szMonth = CStr(Month(dtTemp))

end if

if (len(CStr(Day(dtTemp))) < 2) then

szDay = "0" & CStr(Day(dtTemp))

else

szDay = CStr(Day(dtTemp))

end if

szYear = Year(dtTemp)

szPath = "D:\FILES"

szDate = szYear & szMonth & szDay

inFilename = szPath & "\" & szYear & "\" & szMonth

outFilename = szPath & "\Archive\COMPRESSED" & ".ZIP"

Wscript.Echo WindowsZip(inFilename, outFilename, szPath, szDate)

 Wscript.Echo FTPUpload("xx.xx.xx.xx", "userid", "password", outFilename, "REMOTEPATH", szPath, szDate, szYear, szMonth)

Save the above script as compress_ftp.vbs, and run it on task scheduler with cscript. For the total file size around 20GB, this process will take around 1 hour.