2014-01-28 72 views
0

我有在Outlook中宏的一個問題,我創建這個代碼用於出口的最後消息(最近)在。味精格式化硬盤:警報在Outlook

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!

回答

0

查看http://www.outlookcode.com/article.aspx?id=52瞭解您的選擇列表。安裝最新的AV產品(如果您可以控制用戶環境)或使用Redemption可能是您的最佳選擇。

UPDATE:

使用贖回,所有你需要做的就是

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

更換線

Item.SaveAs sPath & sName, olMSG 

到複雜的我而言,我在VBA首發:C – user3245220

+0

見更新的答案。它只是兩行額外的代碼。 –