Question

我在Outlook中有一个宏的问题，我创建此代码以将最后一条消息（最近的）以.msg格式导出到硬盘驱动器：

Sub prueba(Item As Outlook.MailItem)


Dim oApp As Outlook.Application
Dim oNameSpace As NameSpace
Dim oFolder As MAPIFolder
Dim oMailItem As MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String


Application.DisplayAlerts = False
enviro = CStr(Environ("USERPROFILE"))
Set oApp = New Outlook.Application
Set oNameSpace = oApp.GetNamespace("MAPI")
Set oFolder = oNameSpace.Folders("carpetas personales").Folders("bandeja de entrada").folders("modificacion de ajustes")   


Set Items = oFolder.Items
Items.Sort "[ReceivedTime]", False
Set Item = Items.GetLast

Set oMail = objItem
sName = Item.Subject
ReplaceCharsForFileName sName, "_"
dtDate = Item.ReceivedTime
sName = Format(dtDate, "yyyy-mm-dd", vbUseSystemDayOfWeek, _
vbUseSystem) & "-" & sName & ".msg"
 sPath = "C:\Riot Games\Mensajes\" & Format(dtDate, "yyyy", vbUseSystemDayOfWeek, _
vbUseSystem) & "\" & Format(dtDate, "mm", vbUseSystemDayOfWeek, _
vbUseSystem) & "\"

Debug.Print sPath & sName
MsgBox (sPath & sName)
 Item.SaveAs sPath & sName, olMSG


End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _)

  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
End Sub

它有效，但展望（2013）要求确认，我想避免这种情况，我该怎么做？ ty！

Answer 1

请参阅http://www.outlookcode.com/article.aspx?id=52以获取您的选择列表。安装最新的AV产品（如果您可以控制用户环境）或使用Redemption可能是您的最佳选择。

更新：

要使用Redemption，您需要做的就是替换

行

Item.SaveAs sPath & sName, olMSG

与

set sItem = CreateObject("Redemption.safeMailItem")
sItem.Item = Item
sItem.SaveAs sPath & sName, olMSG

前景警报

1 个答案: