K
krazymike
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
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