vbscript to split up pst file
@discussions.microsoft.com Jim
I created the following vbscript create a new PST file according to quarter.
I have been able to create the new pst file but cannot figure out how to copy
over the folder strcture and emails within the given dates from the source
pst to the newly created destination. Can somone give me a hint as to where
I can go from here?
I'm pretty good at batch scripting but vbscript is a whole new world to me.
so go easy on me :)
What I have so far -
Option Explicit
On error resume next
Dim objOutlook, objNameSpace, oBQ, oEQ, oYEAR, oSOURCE, oDEST
oBQ = inputbox ("Enter beginning quarter")
if (oBQ<1 or oBQ>4) then
wscript.echo "The number " & oBQ & " does not signify a quarter. You are a
dork."
wscript.quit
End if
oEQ = inputbox ("Enter ending quarter")
if (oEQ<1 or oEQ>4) then
wscript.echo "The number " & oEQ & " does not signify a quarter. You are
a dork."
wscript.quit
End if
oYEAR = inputbox ("Enter the year")
if (oYEAR<1990 or oYEAR>2020) then
wscript.echo "The number " & oYEAR & "is either before 1990 or after 2020.
Either way, you are a dork."
wscript.quit
End If
oSOURCE = inputbox ("Enter the name of the source .pst file. Note: file
must be in the c:\email folder. <e.g. 'jsim' NOT 'jsim.pst'>")
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
objNameSpace.AddStore "C:\email\" & objNameSpace.CurrentUser & "_Q" & oBQ &
"- Q" & oEQ & "_" & oYEAR & ".pst"
Set objNameSpace = Nothing
Set objOutlook = Nothing
Jeffery Hicks
I would try using EXMERGE in batch mode. You can specify export limits
such as date.
--
Jeffery Hicks - www.ScriptingAnswers.com
SAPIEN Technologies - Scripting, Simplified. www.SAPIEN.com
Scripting books: www.SAPIENPress.com
Jim
1. I've never ued it before and from what I've read and heard it is used
specifically to take data from an existing mailbox in exchange, dump it to
pst and then move it to a differnt mailbox. Folks that I spoke with said
that is can only be used to pull data from an account not from 1 pst to
another
2. I'm working on coming up with the process the actual leg work would be
done by someone with no access to the exchange server from where the
application needs to be run as I understand
That said I was able to find a script that claims it will do exactly what I
need. Just my luck though every time I run it acording to its directions it
creates the new pst file but does nto copy any data over to it. My
understanding of VB is pretty minimum so I can't figure out what it won't
copy the stuff over. Would someone be able to take a look at with for me and
give me a hint as to where to take it from here?
script can be found here:
http://www.windowsitpro.com/MicrosoftExchangeOutlook/Article/ArticleID/39176/39176.html
TDM
"Jim" <J...@discussions.microsoft.com> wrote in message
news:321E6C7D-E17C-4B15...@microsoft.com...
> Boy its hard to beleive that there is no automatable method of performing
> this time consuming task.
Jim,
I have been watching this post to see how it comes out, I thought this
would be a usefull script. I took a look at the link you provided and
had a look at the script. I ran the beast and sure enough, it did nothing
for me as well. I decided to see where it was busticated. The big
problem seems to be the mail item validation. For some reason
it is checking for "not equal to" when it should be "equal to"
I also did not like the fact that it wacked all my personal folders
from my Outlook profile, so I commented that stuff out.
Watch for line WRAP !! , and just an FYI, I put in a bunch
more echo's so I could figure out what was going on.
This script works fine for me now on WinXP/SP2, with Outlook2003.
' ==================================================================
Option explicit
Dim olApp
Dim olNameSPace
Dim inbox
Dim myfolder
Dim pAItems
Dim archive
Dim newarchive
Dim startDate
Dim endDate
Dim fs
Dim rootStoreID
Dim archStoreID
Dim newarchStoreID
Dim archFileName
Dim newarchFileName
Dim oArgs
Dim x
Dim temp
Const olFolderCalendar = 9
Const olFolderInbox = 6
Const mailItemClass = 43
Const olMailItem = 0
Set oArgs = Wscript.Arguments
If oArgs.Count < 3 Then
WScript.Echo "USAGE: PSTSplitter.vbs <startdate> <enddate> <pstfile>
[newfilename]"
WScript.Echo "Example: PSTSplitter.vbs 1/1/2000 12/31/2000 q:\archive.pst
q:\newarchive.pst"
WScript.Echo ""
WScript.Echo "Note: If newFileName is not specified, a new filname will
automatically"
WScript.Echo " be generated"
WScript.Quit
End If
WScript.Echo "Defining date ranges..."
startDate = DateValue(oArgs(0))
WScript.Echo "Start Date: " & startDate
endDate = DateValue(oArgs(1))
WScript.Echo "End Date: " & endDate
archFileName = oArgs(2)
If startDate > endDate Then
WScript.Echo "INVALID: Start date is after end date"
WScript.Quit 1
End If
Set olApp = CreateObject("Outlook.Application")
Set olNameSpace = olApp.GetNameSpace("MAPI")
rootStoreID = olNameSpace.GetDefaultFolder(olFolderInbox).parent.storeId
Set fs = CreateObject("Scripting.FileSystemObject")
If NOT fs.FileExists(archFileName) Then
WScript.Echo "Archive file doesn't exist"
WScript.Echo "Make sure the path to the .pst file contains no spaces"
WScript.Quit 1
End If
If oArgs.Count = 4 Then
' === New archive name was specified.
newarchFileName = oArgs(3)
Else
' === Generate a filename for new archive.
newarchFileName = genNewFilename(archFileName, oArgs(0), oArgs(1))
End If
WScript.echo "Current Archive: " & archFileName
WScript.echo "New Archive: " & newarchfilename
'WScript.echo "Closing any opened .pst file to avoid conflict"
'Dim i, temp
'For i = olNameSpace.Folders.count To 1 Step -1
' temp = olNameSpace.Folders(i).storeID
' If Left(temp,75) <> Left(rootStoreID,75) Then
' ' === At least the first 75 digits of the rootStoreID
' ' are the same for items that aren't Personal Folders.
' ' Since they're not equal, this must be a
' ' Personal Folder. Close it.
' olNameSpace.RemoveStore olNameSpace.Folders(i)
' End If
'Next
Wscript.echo vbCrLf & "Opening .pst files"
olNameSpace.AddStore archfilename
Wscript.echo vbCrLf & "Setting archive .."
For x = olNameSpace.Folders.count To 1 Step -1
temp = olNameSpace.Folders(x).storeID
If Left(temp,75) <> Left(rootStoreID,75) Then
' === This must be the old archive. Save the storeID
' and reference to the MAPIFolder instance.
Set archive = olNameSpace.Folders(x)
WScript.Echo "Archive set to : " & olNameSpace.Folders(x).Name
archStoreID = temp
End If
Next
olNameSpace.AddStore newarchfilename
Wscript.echo vbCrLf & "Setting New archive .."
For x = olNameSpace.Folders.count To 1 Step -1
temp = olNameSpace.Folders(x).storeID
' === We need to get the reference to the MAPIFolder instance
' of the new .pst file by looking for .pst files currently
' opened in Outlook (using AddStore). We also need to make
' sure that this storeID isn't the same as the one for
' the old archive, or we will be referencing the old
' archive rather than the new one.
If (Left(temp,75) <> Left(rootStoreID,75)) AND (temp <> archStoreID) Then
Set newarchive = olNameSpace.Folders(x)
WScript.Echo "New Archive set to : " & olNameSpace.Folders(x).Name
newarchStoreID = temp
End If
Next
WScript.Echo vbCrLf & "PST To archive from : " & vbTab & archive
WScript.Echo "PST To archive to : " & vbTab & newarchive
createFolders archive, newarchive, startDate, endDate
WScript.Echo "Closing .pst files"
'olNameSpace.RemoveStore archive
'olNameSpace.RemoveStore newarchive
WScript.Echo "SUGGESTION: open up the old archive in Outlook and compact it
" & _
"to reclaim the lost space"
WScript.Quit 0
Sub createFolders(root, newarch, sDate, eDate)
Dim rootNS
Dim rootFolders
Dim newRoot
Dim subRoot
Dim newSubRoot
Dim i
Dim j
Set rootNS = root
Set rootFolders = root.Folders
Set newRoot = newarch
WScript.Echo "Checking archive status for " & rootNS.Items.Count & " items
from " & rootNS.Name & " ..."
For j = rootNS.Items.Count to 1 Step -1
WScript.Echo "Checking " & rootNS.Items(j).Subject
IF (rootNS.Items(j).CreationTime > sDate) AND
(rootNS.Items(j).CreationTime < eDate) AND (rootNS.Items(j).Class =
mailItemClass) Then
' === This item is within the start and end dates.
WScript.Echo "Moving " & rootNS.Items(j).Subject
rootNS.Items(j).Move newRoot
If Err.number > 0 Then
WScript.Echo "Error: " & Err.Description
End If
End If
Next
If rootFolders.Count = 0 Then
' === Stop condition reached
Exit Sub
End If
On Error Resume Next
For i = 1 to rootFolders.count
Set subRoot = rootNS.Folders(i)
WScript.Echo vbCrLf & "Processing Folder : " & rootNS.Folders(i).Name
If subRoot.DefaultItemType = olMailItem Then
' === Create the folder in the new archive
WScript.Echo "Creating " & subRoot
newRoot.Folders.add("" & subRoot)
' === Set the current subfolder in the new archive
' to the newly created folder above.
Set newSubRoot = newRoot.Folders("" & subRoot)
WScript.Echo subRoot & " " & subRoot.items.count
If subRoot.class = 2 Then
' === This is a MAPIfolder. Call this
' subroutine with the root and newroot as
' the current subdirectories.
createFolders subRoot, newSubRoot, sDate, eDate
End If
End If
Next
End Sub
Function genNewFilename(str, sDate, eDate)
sDate = replaceText(sDate,"/","")
sDate = replaceText(sDate,"\\","")
eDate = replaceText(eDate,"/","")
eDate = replaceText(eDate,"\\","")
Dim pos, tempname
pos = InStr(1,str,".pst",1)
If pos <> 0 Then
tempname = Left(str,pos-1)
Else
tempname = str
End If
genNewFilename = tempname & "_" & sDate & "_" & eDate & ".pst"
End Function
Function ReplaceText(str1, oldstr, newstr)
Dim regEx
Set regEx = New RegExp
regEx.Pattern = oldstr
regEx.IgnoreCase = True
regEx.Global = True
ReplaceText = regEx.Replace(str1,newstr)
End Function
TDM
jasper...@gmail.com
To download visit:- https://www.osttopstapp.com/split-pst.html
Mayayana
| Split PST Tool software which can split large PST file
.Net-dependent software to do a simple thing, the author
clearly doesn't know English very well, the price is
nowhere to be found, and the installer contains a
4.5 MB DLL named Aspose.email.dll. An emailing program
in a file splitter? Turns out the DLL is from a company
called Aspose and that's actually the thing doing the
file splitting.
https://en.wikipedia.org/wiki/Aspose_API
There's a 1/2 MB of EXEs in the package and
they can't even split a file -- a job that could be done with
a few KB of simple code by any compiled software. Instead,
a giant DLL intended for a large number of MS-Office-related
operations is doing the work!
Actually, it's not entirely inappropriate to the group,
though. File splitting can be done with VBS, assuming
a computer not set to an oriental codepage. Not
pretty, but it works. One just needs to find the file
length, read that much via Textstream, and write it
back. If it might have nulls then each byte can be
converted to numeric. The only drawback of binary
operations in VBS is with reading strings: When you
look at it as a string, the first null becomes the end
of the data. But as long as you handle the bytes
without "seeing a string" it works fine. There's also
ADODB.
Daniel Jones
Read More:- https://www.betavare.com/split-pst/