Olá pessoal, Tenho um script que transfere as mensagens recebidas para o disco rígido, no entanto, tenho algumas mensagens que tenho o mesmo nome no campo assunto e quando esta é transferida sobrepõe a anterior. Existe alguma forma de incluir a data no campo assunto antes da transferência? Desde agradeço qualquer ajuda. Segue o "script" Option Explicit
'esta macro salva a mensagem na rede
Public Sub SalvarMensagemNaRede(Item As Outlook.MailItem)
Dim sPath As String
Dim sSubject As String
'define a pasta de salvamento
sPath = "G:\UCLA\TS - CTG"
'limpa o assunto
sSubject = Item.Subject
sSubject = Replace(Trim(sSubject), ":", " ")
sSubject = Replace(Trim(sSubject), "<=", " ")
sSubject = Replace(Trim(sSubject), "=>", " ")
sSubject = Replace(Trim(sSubject), "/", " ")
sSubject = Replace(Trim(sSubject), ",", " ")
sSubject = Replace(Trim(sSubject), "<", " ")
sSubject = Replace(Trim(sSubject), ">", " ")
sSubject = Replace(Trim(sSubject), ".", " ")
sSubject = Replace(Trim(sSubject), "&", " ")
sSubject = Replace(Trim(sSubject), "*", " ")
sSubject = Replace(Trim(sSubject), "!!", " ")
sSubject = Replace(Trim(sSubject), "!", " ")
sSubject = Replace(Trim(sSubject), "é", "e")
sSubject = Replace(Trim(sSubject), "ã", "a")
sSubject = Replace(Trim(sSubject), "ç", "c")
sSubject = Replace(Trim(sSubject), "Ã", "a")
sSubject = Replace(Trim(sSubject), "Ç", "c")
sSubject = Replace(Trim(sSubject), "(", " ")
sSubject = Replace(Trim(sSubject), ")", " ")
sSubject = Replace(Trim(sSubject), "?", " ")
sSubject = Replace(Trim(sSubject), "*", " ")
sSubject = Replace(Trim(sSubject), "[", " ")
sSubject = Replace(Trim(sSubject), "]", " ")
sSubject = Replace(Trim(sSubject), ";", " ")
sSubject = Replace(Trim(sSubject), "#", " ")
sSubject = Replace(Trim(sSubject), "+", " ")
sSubject = Replace(sSubject, Chr(34), " ")
If sSubject <> "" Then
Item.SaveAs sPath & "\" & sSubject & ".msg", olMSG
End If
End Sub
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
End Sub
