VBS script to add 2 PSt files into Outlook - 99% complete ?

I have a text file called MYPst.txt stored on a network drive which shows the file paths for the PST files, there are 2 PST files.  One is on a H drive & the other is the default archive pst found in C:\Documents and Settings\some user\Local Settings\Application Data\Microsoft\Outlook\archive.pst.

The idea is that the script will open the text file & read the file locations in then Pop out locations in a message box, which it does ok.

It should then add the PST files to Outlook, it adds the first PST file ok but then errors on adding the second (Line 24; Char1) (Error Outlook failed to add the personal store to this session) Code 80004005

Can anyone help please ?


Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objFile = objFSO.OpenTextFile("H:\MyPst.txt", ForReading) 
 
Const ForReading = 1 
 
Dim arrFileLines() 
i = 0 
Do Until objFile.AtEndOfStream 
Redim Preserve arrFileLines(i) 
arrFileLines(i) = objFile.ReadLine 
i = i + 1 
Loop 
objFile.Close 
 
'Then you can iterate it like this 
 
For Each strLine in arrFileLines 
WScript.Echo strLine 

Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
'Set oShell = CreateObject("WScript.Shell")
'oShell.Run "outlook.exe", 1, False
objNameSpace.AddStore strLine


Next

Open in new window

cochAsked:
Who is Participating?
 
rlandquistCommented:
You are looping for the 2 lines and trying to open outlook twice, etc.  Try this:
Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objFile = objFSO.OpenTextFile("H:\MyPst.txt", ForReading) 
 
Const ForReading = 1 
 
Dim arrFileLines() 
i = 0 
Do Until objFile.AtEndOfStream 
Redim Preserve arrFileLines(i) 
arrFileLines(i) = objFile.ReadLine 
i = i + 1 
Loop 
objFile.Close 
 
'Then you can iterate it like this 
 Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
'Set oShell = CreateObject("WScript.Shell")
'oShell.Run "outlook.exe", 1, False

For Each strLine in arrFileLines 
WScript.Echo strLine 

objNameSpace.AddStore strLine


Next

Open in new window

0
 
Russell LucasIT Infrastructure Project ManagerCommented:
You can try the following:-

 
For Each strLine in arrFileLines 
WScript.Echo strLine 

Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
objNameSpace.AddStore strLine
Set objOutlook = Nothing
Set objNameSpace = Nothing

Next

Open in new window


It maybe because the objects are not being unloaded before the next iteration.
0
 
cochAuthor Commented:
My bad! Working on Vmworkstation and the snapshot that it ws running on did not have the achive.pst created hence it errored as it didnt exist!

Apologies
0
 
cochAuthor Commented:
Points awarded for assistance although I have not tested the solutions
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.