Contact

 
Google
Web www.alanphipps.com

   
   
   
   
www.alanphipps.com

.: Windows Application Deployment - Outlook PST SFX Archive

 
 

 

Once the PST file has been created, it must be delivered to the user securely. Using your favorite compression program such as WinRAR, you can create a Self-Extracting archive that is password protected, this archive can then be posted to the user without fear of interception. The cd will autorun and install the PST file in the correct location without any user interaction other than typing the password that will have been previously emailed to them. This process might sound simple but when you have 3000 PST files to do it becomes necessary to automate the process, as shown below:

Please note that WinRAR is not free, it is, however in my opinion the best compression program, so ask your boss for some money and buy a copy.

 

Create the Folder Structure and Add the Files

Create a folder called PSTSFXArchives. Inside this folder create the following folders:

PSTSFXArchives\ArchiveScript\
PSTSFXArchives\ArchiveScript\WinRAR\

PSTSFXArchives\CD Autorun Files\
PSTSFXArchives\CD Autorun Files\First CD In Series\
PSTSFXArchives\CD Autorun Files\Only CD in Series\
PSTSFXArchives\CD Autorun Files\Other CD's\

PSTSFXArchives\CompleteArchives\

PSTSFXArchives\PSTs\

 

These folders should contain the following files:

PSTSFXArchives\ArchiveScript\ - should contain

Comments.txt - that contains the following code:

Title=Extracting Archive Data
Overwrite=0
Path=%UserProfile%\Local Settings\Application Data\Microsoft\Outlook\
Silent=2

CreateSFXArchives.vbs - that contains the code:

Option Explicit

'On Error Resume Next

Dim FsoFiles, Counter, FileNames, FName, FSO, List, CreateFile, WSH, TempDir, OpenFile, RunBat, CMD
Dim Line, IntStr1, LineLength, FolderName, File, ProgFiles, UserInput, CreateFile1, OpenFile2, FolderName1
Dim UserInput1, CreateFolder1, FolderExist, PSTFolderPath, CompleteArchivePath, BaseFolderPath, FileDelete1
Dim File1, ArchiveScriptPath, FileName, PFPStrLength, PSTsPath, WinRARPath, Run, FileDelete, FileExist10
Dim PFNSourceFolder, TristateFalse, PFNPFNIntStrCompare, PFNPFNIntStrCompare1, PFNIntStr1Count, Run2
Dim PFNSortPath, PFNDriveName, PFNIntCounter, PFNIntStr1, PFNIntStr2, PFNIntStrDiff, PFNVar1, PFNVar2, PFNSourceFolderParsed
Dim PFNStringLength, PFNIntStrRev1, Run1, CreateFile2, FileExist11, CreateFile3, FileDelete2, CreateFile4
Dim Password, VarRnd, VarFor, GetRandomNumber, CreateFile5, FileExist12, OpenFile3
Dim FileExist111, FileExist101, CreateFile21, CreateFile31, Run21, Run11

Dim avarArray(36)
avarArray(0) = "a"
avarArray(1) = "b"
avarArray(2) = "c"
avarArray(3) = "d"
avarArray(4) = "e"
avarArray(5) = "f"
avarArray(6) = "g"
avarArray(7) = "h"
avarArray(8) = "i"
avarArray(9) = "j"
avarArray(10) = "k"
avarArray(11) = "l"
avarArray(12) = "m"
avarArray(13) = "n"
avarArray(14) = "o"
avarArray(15) = "p"
avarArray(16) = "q"
avarArray(17) = "r"
avarArray(18) = "s"
avarArray(19) = "t"
avarArray(20) = "u"
avarArray(21) = "v"
avarArray(22) = "w"
avarArray(23) = "x"
avarArray(24) = "z"
avarArray(25) = "z"
avarArray(26) = "0"
avarArray(27) = "1"
avarArray(28) = "2"
avarArray(29) = "3"
avarArray(30) = "4"
avarArray(31) = "5"
avarArray(32) = "6"
avarArray(33) = "7"
avarArray(34) = "8"
avarArray(35) = "9"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = WScript.CreateObject("WScript.Shell")

TempDir = WSH.ExpandEnvironmentStrings("%Temp%")
CMD = WSH.ExpandEnvironmentStrings("%ComSpec% \C ")

FileName = "CreateSFXArchives.vbs"
Set File1 = FSO.GetFile(FileName)
ArchiveScriptPath = File1.ParentFolder & "\"

PFPStrLength = Len(ArchiveScriptPath)
BaseFolderPath = mid(ArchiveScriptPath, 1, (PFPStrLength - 14))
CompleteArchivePath = BaseFolderPath & "CompleteArchives\"
PSTsPath = BaseFolderPath & "PSTs\"
WinRARPath = ArchiveScriptPath & "WinRAR\"
PFNSourceFolder = PSTsPath
TristateFalse = 0
PFNPFNIntStrCompare = 1
PFNPFNIntStrCompare1 = 4
PFNIntStr1Count = 1

UserInput = MsgBox("This Script will create the Self-Extracting ZIP-Files that will hold each users Mail Archive" & vbCrLf & _
"This File (ArchiveData.exe) should be written to CD along with the Autorun files and given to the User.", vbOKcancel)

If UserInput = vbCancel Then
WScript.Quit
End If

UserInput1 = MsgBox("The PST files for conversion MUST be placed in " & PSTsPath & " - when complete the file ArchiveData.exe" & vbCrLf & _
"will be found in " & CompleteArchivePath & " - Read " & ArchiveScriptPath & "\CreateArchiveInstructions.txt for further Info", vbOKcancel)

If UserInput1 = vbCancel Then
WScript.Quit
End If

MsgBox "The Passwords.csv file will be located in the " & CompleteArchivePath & " folder"

PFNStringLength = Len(PFNSourceFolder)

PFNIntStrRev1 = InstrRev(PFNSourceFolder, CHR(92), PFNStringLength, 1)

PFNSortPath = Mid(PFNSourceFolder, 1, 2)
If PFNSortPath = "\\" Then
msgBox "The Path given: " & vbCr & vbCr & PFNSourceFolder & vbCr & vbCr & "is a newtork drive and is unusable." & _
" Please map the drive so that it has a drive letter, then run the script again."
Wscript.Quit
End If

PFNDriveName = Mid(PFNSourceFolder, 1, 1)

For PFNIntCounter = 1 to 100

If PFNIntStr1 = PFNIntStrRev1 Then
PFNIntCounter = 100
End If

PFNIntStr1 = Instr(PFNPFNIntStrCompare, PFNSourceFolder, CHR(92), 1)
PFNIntStr2 = Instr(PFNPFNIntStrCompare1, PFNSourceFolder, CHR(92), 1)
PFNPFNIntStrCompare = PFNIntStr1 + 1
PFNPFNIntStrCompare1 = PFNIntStr2 + 1
PFNIntStrDiff = PFNIntStr2 - PFNIntStr1
If PFNIntStrDiff < 0 Then
PFNIntStrDiff = 2
End If
If PFNPFNIntStrCompare1 > PFNStringLength Then
PFNIntCounter = 100
End If
If PFNIntStr1 = "" Then
PFNIntStr1 = ""
PFNIntCounter = 100
Else
PFNIntStr1Count = PFNIntStr1Count + 1
End If
If PFNIntStr2 = "" Then
PFNIntStr2 = PFNStringLength
End If

PFNVar1 = Mid(PFNSourceFolder, PFNPFNIntStrCompare, PFNIntStrDiff - 1)

PFNVar2 = PFNVar2 & ".SubFolders(" & CHR(34) & PFNVar1 & CHR(34) & ")"

PFNSourceFolderParsed = "FSO.Drives(" & CHR(34) & PFNDriveName & ":" & CHR(34) & ").RootFolder"

Next

PFNSourceFolderParsed = PFNSourceFolderParsed & PFNVar2 & ".Files"

Set CreateFile = FSO.CreateTextFile(TempDir & "\001TempFile.vbs", True)
With CreateFile
.Writeline "Dim FsoFiles, Counter, FName, FSO, CreateFile, TempDir, WSH, file, OpenFile"
.WriteBlankLines(1)
.WriteLine "Set FSO = CreateObject(" & CHR(34) & "Scripting.FileSystemObject" & CHR(34) & ")"
.WriteLine "Set WSH = WScript.CreateObject(" & CHR(34) & "WScript.Shell" & CHR(34) & ")"
.WriteLine "TempDir = WSH.ExpandEnvironmentStrings(" & CHR(34) & "%Temp%" & CHR(34) & ")"
.WriteLine "Set FSOFiles = " & PFNSourceFolderParsed
.WriteBlankLines(1)
.WriteLine "Counter = FSOFiles.Count"
.WriteBlankLines(1)
.WriteLine "Set CreateFile = FSO.CreateTextFile(TempDir & " & CHR(34) & "\FName.txt" & CHR(34) & ", True, 0)"
.WriteLine "CreateFile.Close"
.WriteBlankLines(1)
.WriteLine "for each file in FSOFiles"
.WriteLine "Fname = lcase(FSO.GetFileName(file.name))"
.WriteLine "Set OpenFile = FSO.OpenTextFile(TempDir & " & CHR(34) & "\FName.txt" & CHR(34) & ", 8, False, 0)"
.WriteLine "OpenFile.WriteLine Fname & vbCr"
.WriteLine "OpenFile.Close"
.WriteLine "next"
.WriteLine "WScript.Quit"
.Close
End With

WScript.Sleep 1000

Run = WSH.Run(TempDir & "\001TempFile.vbs", 0, True)

WScript.Sleep 1000

FileDelete = FSO.DeleteFile(TempDir & "\001TempFile.vbs", True)

Set OpenFile2 = FSO.OpenTextFile(TempDir & "\FName.txt", 1, False, 0)
Do While OpenFile2.AtEndofStream = False
Line = OpenFile2.ReadLine
LineLength = Len(Line)
FolderName = Mid(Line, 1, LineLength - 5)
FolderName1 = Replace(FolderName, " ", ".", 1, -1, vbTextCompare)
IntStr1 = Instr(1, Line, ".pst", 1)
If IntStr1 > 0 Then
FolderExist = FSO.FolderExists(CompleteArchivePath & Foldername1)
If FolderExist = False Then
Set CreateFolder1 = FSO.CreateFolder(CompleteArchivePath & Foldername1)
End If
Set CreateFile4 = FSO.CreateTextFile(CompleteArchivePath & Foldername1 & CHR(92) & Foldername1 & ".txt", True)
With CreateFile4
.Write "This file indicates the name of the recipient for the CD."
.close
End With
FileExist12 = FSO.FileExists(CompleteArchivePath & "Passwords.csv")
If FileExist12 = False Then
Set CreateFile5 = FSO.CreateTextFile(CompleteArchivePath & "Passwords.csv", True)
CreateFile5.close
End If

CreatePassword()

Set OpenFile3 = FSO.OpenTextFile(CompleteArchivePath & "Passwords.csv", 8, False, 0)
OpenFile3.WriteLine FolderName1 & "," & Password
OpenFile3.close

Set CreateFile1 = FSO.CreateTextFile(TempDir & "\CreateArchive.bat", True)
CreateFile1.Write "@ECHO off" & vbCrLf & CHR(34) & WinRARPath & "WinRAR.exe" & CHR(34) & " a -sfx -p" & Password & " -ep -m5 -v680M -o- " & _
" -z" & CHR(34) & WinRARPath & "Comments.txt" & CHR(34) & " " & CHR(34) & CompleteArchivePath & FolderName1 & "\ArchiveData" & CHR(34) & " " & CHR(34) & _
PSTsPath & Foldername & ".pst" & CHR(34) & vbCrLf & "exit"
CreateFile1.Close
RunBat = WSH.Run(CHR(34) & TempDir & "\CreateArchive.bat" & CHR(34), 1, True)
WScript.Sleep 1000

End If
loop
OpenFile2.Close


Set FsoFiles=Nothing
Set Counter=Nothing
Set FileNames=Nothing
Set FName=Nothing
Set FSO=Nothing
Set List=Nothing
Set CreateFile=Nothing
Set WSH=Nothing
Set TempDir=Nothing
Set OpenFile=Nothing
Set Line=Nothing
Set IntStr1=Nothing
Set LineLength=Nothing
Set FolderName=Nothing
Set File=Nothing
Set ProgFiles=Nothing
Set UserInput=Nothing
Set CreateFile=Nothing
Set OpenFile2=Nothing
Set RunBat=Nothing
Set UserInput1=Nothing
Set CreateFolder1=Nothing
Set FolderExist=Nothing
Set PFPStrLength=Nothing
Set PSTsPath=Nothing
Set WinRARPath=Nothing
Set PSTFolderPath=Nothing
Set CompleteArchivePath=Nothing
Set BaseFolderPath=Nothing
Set ArchiveScriptPath=Nothing
Set CreateFile3=Nothing

'On Error Goto 0

MsgBox "Script Complete"

Function CreatePassword

Password=""

For VarFor = 1 to 10
Randomize
GetRandomNumber = Round(FormatNumber(Int((35*Rnd()) + 1)))
If GetRandomNumber = 1 Then VarRnd = avarArray(1)
If GetRandomNumber = 2 Then VarRnd = avarArray(2)
If GetRandomNumber = 3 Then VarRnd = avarArray(3)
If GetRandomNumber = 4 Then VarRnd = avarArray(4)
If GetRandomNumber = 5 Then VarRnd = avarArray(5)
If GetRandomNumber = 6 Then VarRnd = avarArray(6)
If GetRandomNumber = 7 Then VarRnd = avarArray(7)
If GetRandomNumber = 8 Then VarRnd = avarArray(8)
If GetRandomNumber = 9 Then VarRnd = avarArray(9)
If GetRandomNumber = 10 Then VarRnd = avarArray(10)
If GetRandomNumber = 11 Then VarRnd = avarArray(11)
If GetRandomNumber = 12 Then VarRnd = avarArray(12)
If GetRandomNumber = 13 Then VarRnd = avarArray(13)
If GetRandomNumber = 14 Then VarRnd = avarArray(14)
If GetRandomNumber = 15 Then VarRnd = avarArray(15)
If GetRandomNumber = 16 Then VarRnd = avarArray(16)
If GetRandomNumber = 17 Then VarRnd = avarArray(17)
If GetRandomNumber = 18 Then VarRnd = avarArray(18)
If GetRandomNumber = 19 Then VarRnd = avarArray(19)
If GetRandomNumber = 20 Then VarRnd = avarArray(20)
If GetRandomNumber = 21 Then VarRnd = avarArray(21)
If GetRandomNumber = 22 Then VarRnd = avarArray(22)
If GetRandomNumber = 23 Then VarRnd = avarArray(23)
If GetRandomNumber = 24 Then VarRnd = avarArray(24)
If GetRandomNumber = 25 Then VarRnd = avarArray(25)
If GetRandomNumber = 26 Then VarRnd = avarArray(26)
If GetRandomNumber = 27 Then VarRnd = avarArray(27)
If GetRandomNumber = 28 Then VarRnd = avarArray(28)
If GetRandomNumber = 29 Then VarRnd = avarArray(29)
If GetRandomNumber = 30 Then VarRnd = avarArray(30)
If GetRandomNumber = 31 Then VarRnd = avarArray(31)
If GetRandomNumber = 32 Then VarRnd = avarArray(32)
If GetRandomNumber = 33 Then VarRnd = avarArray(33)
If GetRandomNumber = 34 Then VarRnd = avarArray(34)
If GetRandomNumber = 35 Then VarRnd = avarArray(35)
If GetRandomNumber = 36 Then VarRnd = avarArray(36)

Password = Password & VarRnd
Next

End Function

WScript.Quit

 

PSTSFXArchives\ArchiveScript\WinRAR\ - should contain

This folder contains all the files from the WinRAR program folder.

 

PSTSFXArchives\CD Autorun Files\First CD In Series\ - should contain

Autorun.bat - that contains the following code:

@ECHO off

start .\Autorun.vbs

exit

Autorun.inf - that contains the following code:

[autorun]
OPEN=Autorun.bat

Autorun.vbs - that contains the following code:

Option Explicit

Dim UserChoice, RunApp, WshShell, WSH, UserName

Set WSH = WScript.CreateObject("WScript.Shell")

UserName = WSH.ExpandEnvironmentStrings("%UserName%")

UserChoice = MsgBox("This CD Contains Your Outlook PST File." & VbCrLf & vbCrLf & _
"It Will be Copied to the Following Path:" & vbCrLf & vbCrLf & _
"C:\Documents and Settings\" & UserName & "\Local Settings\Application Data\Microsoft\Outlook\" & vbCrLf & vbCrLf & _
"When Complete, Open outlook and Select File - Open - Outlook Data File to access your Data File", VBOkCancel, "Outlook PST Data")

IF UserChoice = 1 Then
Set WshShell = CreateObject("WSCript.Shell")
RunApp = WshShell.Run(".\ArchiveData.part1.exe")
WScript.Quit
End If

IF UserChoice = 2 Then
WScript.Quit
End IF

PSTSFXArchives\CD Autorun Files\Only CD In Series\ - should contain

Autorun.bat - that contains the following code:

@ECHO off

start .\Autorun.vbs

exit

Autorun.inf - that contains the following code:

[autorun]
OPEN=Autorun.bat

Autorun.vbs - that contains the following code:

Option Explicit

Dim UserChoice, RunApp, WshShell, WSH, UserName

Set WSH = WScript.CreateObject("WScript.Shell")

UserName = WSH.ExpandEnvironmentStrings("%UserName%")

UserChoice = MsgBox("This CD Contains Your Outlook PST File." & VbCrLf & vbCrLf & _
"It Will be Copied to the Following Path:" & vbCrLf & vbCrLf & _
"C:\Documents and Settings\" & UserName & "\Local Settings\Application Data\Microsoft\Outlook\" & vbCrLf & vbCrLf & _
"When Complete, Open outlook and Select File - Open - Outlook Data File to access your Data File", VBOkCancel, "Outlook PST Data")

IF UserChoice = 1 Then
Set WshShell = CreateObject("WSCript.Shell")
RunApp = WshShell.Run(".\ArchiveData.exe")
WScript.Quit
End If

IF UserChoice = 2 Then
WScript.Quit
End IF

PSTSFXArchives\CD Autorun Files\Other CD's\ - should contain

Autorun.bat - that contains the following code:

@ECHO off

start .\Autorun.vbs

exit

Autorun.inf - that contains the following code:

[autorun]
OPEN=Autorun.bat

Autorun.vbs - that contains the following code:

MsgBox "Due to it's size, your PST Mail archive was spanned over a number of CD's" & vbCrLf & vbCr & _
"If you have already extracted from CD 1 then press OK and Ignore this message" & vbCrLf & vbCr & _
"If you have not extracted from CD 1 then please insert CD 1 and run that CD first.", VBOKonly

 

PSTSFXArchives\CompleteArchives\ - should contain

This folder will hold the complete SFX Archives and MUST be empty when the script is run. The passwords.csv file that will hold the Archive passwords is also created in this folder.

 

PSTSFXArchives\PSTs\ - should contain

The PST files to be made into SFX Archves should be placed in this folder before the script is run.

 

Script Execution

Before the script is started, make sure that the CompleteArchives folder is empty and that the PST files are in the PSTs folder. If by accident you run the script before removing the password.csv file then the script will not overwrite the file but append to it, so no passwords will be lost. Once the files are in place run the PSTSFXArchives\ArchiveScript\CreateSFXArchives.vbs script and press OK to the 3 message boxes. If the script is run from a network folder whose path starts with "\\" then an error will occur, make sure that the drive that script script runs from has a drive letter.

Once the archives are complete the archive will be named ArchiveData.exe and will be in its own folder named with the PST file name as shown below:

PST Archives - Complete Archive

If the archive spans more than one CD, the archive will be automatically split into CD sized files. Each Archive needs a set of the autorun files when it is written to CD, i believe the name of the autorun folders explains which files to use for which archive.

Note:

If you find that your archives contain the wrong icon or have other incorrect features, then open WinRAR and modify the SFX default Options, For Your Information the default SFX options are stored in the registry at:

HKEY_CURRENT_USER\Software\WinRAR\SFX\Default

All Done.

Now you can go back to the Deployment page .

 

     
 
 
     

 

Web site contents © Copyright Alan Phipps 2006, All rights reserved.

Website templates
   
 
 

 

__PayPal

 
Please Donate to the Nvidia Geforce Go 7950 GTX Fund, All donations welcome. Thanks.