saving emails from a public folder to a hard drive

[Matt Dangerfield]

Hi all I have the code which does this.... but with one problem, it uses
PickFolder. I would like to hard code a path to the script because th
efolder I am backing up every night does not change. Heres the code:
Code supplied by a person I work with who has even less of an idea about
VB than I do

please help if you can.


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")
Set MAPIFolderObject = FoldersCollection.Item(Index)
Set ofChosenFolder = myNameSpace.PickFolder


strSavePath = "H:\Data\Mail\"

If MAPIFolderObject Is Inbox Then
MsgBox "Public Folders folder not found 2 ", vbCritical
End If


If not right(strSavePath,1) = "\" then
strSavePath = strSavePath & "\"
wscript.echo "If You can read this then the script is broke." & vbcrlf &
"Email (e-mail address removed)."
End If

strSaveFolder = Left(strSavePath, Len(strSavePath)-1)

If Not objFSO.FolderExists(strSaveFolder) then
if MsgBox("The folder you specified does not exist." & vbcrlf & "Would
you like one created?", VBYesNo, "Folder Not Found") = 7 then
wscript.echo "Exiting script. Try again."
Else
objFSO.CreateFolder(strSaveFolder)
wscript.echo strSaveFolder & " - Created"
End if
End if


i = 6
For each Item in ofChosenFolder.Items
Set myItem = ofChosenFolder.Items(i)
strReceived = ArrangedDate(myitem.ReceivedTime)
strSubject = 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

Set RegX = New RegExp

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

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

Set RegX = nothing

End Function



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Sue Mosher [MVP-Outlook]]

To get a non-default folder without using Namespace.PickFolder, you need to
walk the folder hierarchy using the Folders collections or use a function
that does that for you. See http://www.outlookcode.com/d/code/getfolder.htm