Outlook - script

[Lotan]

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

Editado Fevereiro 27, 2011 por kuroi
Adicionar tag CODE