Ok, i have this code in VBA format in an access module that runs perfectly.
What it does is extract all items in a .pst file to .msg files. I am
converting it to VBS to try to slim some overhead. (Some of the .pst files
have hundreds of thousands of mail items in them, and any clock cycles
shaved off could make hours of difference. My code runs, but the .Items
collection keeps coming back as having a count of zero. What am I doing
wrong?

option explicit
Dim j
Dim str ' , pstName As String
main()
Sub main()
Dim start
dim done
start = Now()
Dim mySession
dim olSession
set mysession = createobject("Redemption.RDOSession")
Dim s ''As RDOSession
Dim pst 'As RDOPstStore
Dim store 'As RDOStore
Dim folder 'As RDOFolder
Dim c 'As New Collection
Dim i 'As Integer
j = 0

str = chooseFile()
Set pst = mySession.LogonPstStore(str)
For Each store In mySession.Stores
Call getFolders(store.IPMRootFolder)
Next
Set mySession = Nothing
done = Now()
MsgBox "start: " & start & vbCr & "Done: " & done & vbCr & j & "
Messages processed", vbExclamation

End Sub

Sub getFolders(fs) 'As RDOFolder)
On Error Resume Next
Dim f 'As RDOFolder
Dim m 'As RDOMail
For Each f In fs.Folders
For Each m In f.Items ' This where the count comes into play
Call getMsgs(m)
Next

Call getFolders(f) ' recurse through the folder tree
Next
End Sub

Sub getMsgs(m) ' As RDOMail)

dim fname 'As String
fname = "C:\tempy\" & m.entryid & ".msg"
msgbox fname
m.SaveAs (fname)
j = j + 1

End Sub

Function chooseFile() ' As String
dim objFSO
dim initfso
Set ObjFSO = CreateObject("UserAccounts.CommonDialog")

ObjFSO.Filter = "PST Files|*.pst"

ObjFSO.FilterIndex = 1

ObjFSO.InitialDir = "c:\psts"

InitFSO = ObjFSO.ShowOpen

If InitFSO = False Then
Wscript.Echo "Script Error: Please select a file!"
Wscript.Quit
Else
' Wscript.Echo "You selected the file: " & ObjFSO.FileName
End If

chooseFile = initfso

End Function

Leaving aside your code, running in VBA will be faster than running in
VBScript, so I'd abandon that idea to begin with.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm


"krazymike" wrote in message
...
Ok, i have this code in VBA format in an access module that runs
perfectly. What it does is extract all items in a .pst file to .msg files.
I am converting it to VBS to try to slim some overhead. (Some of the .pst
files have hundreds of thousands of mail items in them, and any clock
cycles shaved off could make hours of difference. My code runs, but the
.Items collection keeps coming back as having a count of zero. What am I
doing wrong?

option explicit
Dim j
Dim str ' , pstName As String
main()
Sub main()
Dim start
dim done
start = Now()
Dim mySession
dim olSession
set mysession = createobject("Redemption.RDOSession")
Dim s ''As RDOSession
Dim pst 'As RDOPstStore
Dim store 'As RDOStore
Dim folder 'As RDOFolder
Dim c 'As New Collection
Dim i 'As Integer
j = 0

str = chooseFile()
Set pst = mySession.LogonPstStore(str)
For Each store In mySession.Stores
Call getFolders(store.IPMRootFolder)
Next
Set mySession = Nothing
done = Now()
MsgBox "start: " & start & vbCr & "Done: " & done & vbCr & j & "
Messages processed", vbExclamation

End Sub

Sub getFolders(fs) 'As RDOFolder)
On Error Resume Next
Dim f 'As RDOFolder
Dim m 'As RDOMail
For Each f In fs.Folders
For Each m In f.Items ' This where the count comes into play
Call getMsgs(m)
Next

Call getFolders(f) ' recurse through the folder tree
Next
End Sub

Sub getMsgs(m) ' As RDOMail)

dim fname 'As String
fname = "C:\tempy\" & m.entryid & ".msg"
msgbox fname
m.SaveAs (fname)
j = j + 1

End Sub

Function chooseFile() ' As String
dim objFSO
dim initfso
Set ObjFSO = CreateObject("UserAccounts.CommonDialog")

ObjFSO.Filter = "PST Files|*.pst"

ObjFSO.FilterIndex = 1

ObjFSO.InitialDir = "c:\psts"

InitFSO = ObjFSO.ShowOpen

If InitFSO = False Then
Wscript.Echo "Script Error: Please select a file!"
Wscript.Quit
Else
' Wscript.Echo "You selected the file: " & ObjFSO.FileName
End If

chooseFile = initfso

End Function

For *all* folders? Or just RDOStore.IPMRootFolder (which usually has no
messages)?

--
Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
-
"krazymike" wrote in message
...
Ok, i have this code in VBA format in an access module that runs
perfectly. What it does is extract all items in a .pst file to .msg files.
I am converting it to VBS to try to slim some overhead. (Some of the .pst
files have hundreds of thousands of mail items in them, and any clock
cycles shaved off could make hours of difference. My code runs, but the
.Items collection keeps coming back as having a count of zero. What am I
doing wrong?

option explicit
Dim j
Dim str ' , pstName As String
main()
Sub main()
Dim start
dim done
start = Now()
Dim mySession
dim olSession
set mysession = createobject("Redemption.RDOSession")
Dim s ''As RDOSession
Dim pst 'As RDOPstStore
Dim store 'As RDOStore
Dim folder 'As RDOFolder
Dim c 'As New Collection
Dim i 'As Integer
j = 0

str = chooseFile()
Set pst = mySession.LogonPstStore(str)
For Each store In mySession.Stores
Call getFolders(store.IPMRootFolder)
Next
Set mySession = Nothing
done = Now()
MsgBox "start: " & start & vbCr & "Done: " & done & vbCr & j & "
Messages processed", vbExclamation

End Sub

Sub getFolders(fs) 'As RDOFolder)
On Error Resume Next
Dim f 'As RDOFolder
Dim m 'As RDOMail
For Each f In fs.Folders
For Each m In f.Items ' This where the count comes into play
Call getMsgs(m)
Next

Call getFolders(f) ' recurse through the folder tree
Next
End Sub

Sub getMsgs(m) ' As RDOMail)

dim fname 'As String
fname = "C:\tempy\" & m.entryid & ".msg"
msgbox fname
m.SaveAs (fname)
j = j + 1

End Sub

Function chooseFile() ' As String
dim objFSO
dim initfso
Set ObjFSO = CreateObject("UserAccounts.CommonDialog")

ObjFSO.Filter = "PST Files|*.pst"

ObjFSO.FilterIndex = 1

ObjFSO.InitialDir = "c:\psts"

InitFSO = ObjFSO.ShowOpen

If InitFSO = False Then
Wscript.Echo "Script Error: Please select a file!"
Wscript.Quit
Else
' Wscript.Echo "You selected the file: " & ObjFSO.FileName
End If

chooseFile = initfso

End Function