Sync outlook messages with vbscript - vbscript

Question

I have a vbscript that copy's Outlook 2003 messages into a folder in msg format.
The problems are:
I am getting "path too long" errors for some *.msg . I wish to avoid these erros and I don't know how. ' On Error Resume Next is already on the script.
I am getting only inbox messages, but I want all subfolders too;
How can I extract this in *.txt and not in *.msg, in order to become lighter?
Here is my atual script. Thanks for the help!
On Error Resume Next
Dim myNameSpace
Dim ofChosenFolder
Dim myOlApp
Dim myItem
Dim objItem
Dim myFolder
Dim strSubject
Dim strName
Dim strFile
Dim strReceived
Dim strSavePath
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Const olFolderInbox = 6
Set ofChosenFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
strSavePath = "c:\test\" 'OBS! use a \ at the end of the path
i = 1
For each Item in ofChosenFolder.Items
Set myItem = ofChosenFolder.Items(i)
strReceived = ArrangedDate(myitem.ReceivedTime)
' strSubject = myItem.Subject
strSubject = myitem.SenderName & "_" & myitem.Subject
strName = StripIllegalChar(strSubject)
strFile = strSavePath & strReceived & "_" & strName & ".msg"
If Not Len(strfile) > 256 then
myItem.SaveAs strfile, 3
Else
wscript.echo strfile & vbcrlf & "Path and filename too long."
End If
i = i + 1
next
Function StripIllegalChar(strInput)
'***************************************************
'Simple function that removes illegal file system
'characters.
'***************************************************
Set RegX = New RegExp
RegX.pattern = "[\" & chr(34) & "\!\#\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\;\:\<\>\?\/\,]"
RegX.IgnoreCase = True
RegX.Global = True
StripIllegalChar = RegX.Replace(strInput, "")
Set RegX = nothing
End Function
Function ArrangedDate(strDateInput)
'***************************************************
'This function re-arranges the date data in order
'for it to display in chronilogical order in a
'sorted list in the file system. It also removes
'illegal file system characters and replaces them
'with dashes.
'Example:
'Input: 2/26/2004 7:07:33 AM
'Output: 2004-02-26_AM-07-07-33
'***************************************************
Dim strFullDate
Dim strFullTime
Dim strAMPM
Dim strTime
Dim strYear
Dim strMonthDay
Dim strMonth
Dim strDay
Dim strDate
Dim strDateTime
Dim RegX
If not Left(strDateInput, 2) = "10" Then
If not Left(strDateInput, 2) = "11" Then
If not Left(strDateInput, 2) = "12" Then
strDateInput = "0" & strDateInput
End If
End If
End If
strFullDate = Left(strDateInput, 10)
If Right(strFullDate, 1) = " " Then
strFullDate = Left(strDateInput, 9)
End If
strFullTime = Replace(strDateInput,strFullDate & " ","")
If Len(strFullTime) = 10 Then
strFullTime = "0" & strFullTime
End If
strAMPM = Right(strFullTime, 2)
strTime = strAMPM & "-" & Left(strFullTime, 8)
strYear = Right(strFullDate,4)
strMonthDay = Replace(strFullDate,"/" & strYear,"")
strMonth = Left(strMonthDay, 2)
strDay = Right(strMonthDay,len(strMonthDay)-3)
If len(strDay) = 1 Then
strDay = "0" & strDay
End If
strDate = strYear & "-" & strMonth & "-" & strDay
'strDateTime = strDate & "_" & strTime
strDateTime = strDate
Set RegX = New RegExp
RegX.pattern = "[\:\/\ ]"
RegX.IgnoreCase = True
RegX.Global = True
ArrangedDate = RegX.Replace(strDateTime, "-")
Set RegX = nothing
End Function

Answer 1

You need to truncate the file name appropriately (strName)
Move your code that processes a folder into a sub that take fodler that takes folder as parameter and call it for ofChosenFolder as well as all of its child fodlers in the ofChosenFolder.Folders collection.
You are calling SaveAs..., 3 - 3 here is olMsg. Specify olTxt (= 0).
Off the top of my head:
Const olFolderInbox = 6
Set ofChosenFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
trSavePath = "c:\test\"
ProcessFolder ofChosenFolder, trSavePath
sub ProcessFolder(folder, path)
For each Item in folder.Items
strReceived = ArrangedDate(Item.ReceivedTime)
strSubject = Item.SenderName & "_" &Item .Subject
strName = StripIllegalChar(strSubject)
strFile = strSavePath & strReceived & "_" & strName & ".msg"
If Not Len(strfile) > 256 then
Item.SaveAs strfile, 3
Else
wscript.echo strfile & vbcrlf & "Path and filename too long."
End If
next
for each subfolder in folder.Folders
ProcessFolder(subfolder, trSavePath & subfolder.Name & "\"
next
end sub