Shaun McCloud


Ok, I use the script below (or will when it works right) to export emails from Outlook 2003 to a .msg file, and place them in a folder based on the category. The problem is, it does not export every email correctly. Some end up having no extension and being 0KB in size. Does anyone know what in my code could cause this

Code Block

On Error Resume Next
Dim myNameSpace
Dim ofChosenFolder
Dim ParentFolder
Dim Folder
Dim myOlApp
Dim myItem
Dim objItem
Dim myFolder
Dim strSubject
Dim strName
Dim strFile
Dim strReceived
Dim strCategory
Dim strSavePath
Dim strTemp
Dim count

Set objFSO = CreateObject("Scripting.FileSystemObject")
' start outlook if not running, if running use current instance.
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
' login to outlook in case you aren't.
' myOlApp.Logon
Set ofChosenFolder = myNameSpace.PickFolder
count = 0

i = 1
For each Item in ofChosenFolder.Items
Set myItem = ofChosenFolder.Items(i)
strReceived = ArrangedDate(myitem.ReceivedTime)
strSubject = myItem.Subject
strCategory = myItem.Categories
strName = StripIllegalChar(strSubject)
If Not strSubject = "" then
strSaveFolder = "C:\Projects\" & strCategory
If Not objFSO.FolderExists(strSaveFolder) then
objFSO.CreateFolder(strSaveFolder)
'wscript.echo strSaveFolder & " - Created"
End If
strFile = strSaveFolder & "\" & strReceived & "_" & strSubject & ".msg"
Else
strFile = "C:\Projects\" & strReceived & "_" & strSubject & ".msg"
End If
If Not Len(strFile) > 256 then
myItem.SaveAs strfile, 3
'wscript.echo strFile & vbcrlf
count = count + 1
Else
wscript.echo strfile & vbcrlf & "Path and filename too long."
End If

i = i + 1

next

If count = 1 Then
wscript.echo count & " item exported."
Else
wscript.echo count & " items exported."
End If

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

Set RegX = New RegExp

RegX.pattern = "[\:\/\ ]"
RegX.IgnoreCase = True
RegX.Global = True

ArrangedDate = RegX.Replace(strDateTime, "-")

Set RegX = nothing

End Function