使用vbscript

Question

我有一个vbscript，它将Outlook 2003邮件复制到msg格式的文件夹中。

问题是：

• 我的路径太长＆＃34;一些* .msg的错误。我希望避免这些错误，我不知道如何。 ＆＃39; On Error Resume Next已经在脚本上。
• 我只收到收件箱邮件，但我也想要所有子文件夹;
• 如何在* .txt中提取，而不是在* .msg中提取，以便变轻？

这是我的脚本。谢谢你的帮助！

    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

1. 您需要适当地截断文件名（strName）
2. 将处理文件夹的代码移动到一个子文件中，该文件将fodler作为参数，并将其命名为ofChosenFolder以及ofChosenFolder.Folders集合中的所有子文件夹。
3. 您正在调用SaveAs ...，这里的3 - 3是olMsg。指定olTxt（= 0）。

脱离我的头顶：

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