Copiare mail outlook su cartella del pc

[johnatan69]

Ciao a tutti.
Avrei la necessità di impostare una macro da associare ad una regola, che mi consenta di copiare i messaggio Outlook in una cartella esterna allo stesso (p.es: c:\protocollo).
I file creati dovrebbero avere come nome l'oggetto del messaggio (cosa che avviene trascinandoli manualmente) e la macro dovrebbe eliminare i caratteri speciali che non possono essere contenuti nel nome file. Dovrebbe anche creare un progressivo per nome file uguale in caso di oggetto uguale (p.es: prova, prova (1), prova (2) etc etc).
Spero di essere stato chiaro nell'esposizione.
Utilizzo office 2007 e 2010.
Grazie mille per il vs aiuto.

[Anthony47]

Crea la regola facendo in modo che posizioni i messaggi di tuo interessi in un folder specifico.
Poi in Outlook selezioni le email e le sposti (come se spostassi dei file) nella directory che ti interessa

That's all

Ciao

[johnatan69]

Mi servirebbe che lo facesse automaticamente all'arrivo dei messaggi.
Anthony quello che mi dici è quello che faccio adesso ma se lo facesse in automatico sarebbe più funzionale alle esigenze d'ufficio.

[Anthony47]

Questa macro (Sub SaveInMessage) e' pronta per essere richiamata da una regola attivata sulle mail in arrivo che come azione ha "esegui uno script":

Codice: Seleziona tutto

Sub SaveInMessage(inMail As MailItem)
Dim FDir As String
Dim fName As String, I As Long
'
FDir = "C:\PROVA\SALVATI"      '<<< La directory di salvataggio
'
If TypeOf inMail Is MailItem Then
    fName = inMail.Subject
    If Len(fName) < 5 Then fName = fName & Format(inMail.ReceivedTime, "yyyymmdd_hhmmss")
    fName = CreaFName(FDir, fName)
'    Debug.Print fName
    inMail.SaveAs fName, olMSG
End If
End Sub


Function CreaFName(ByVal cDir As String, cFN As String) As String
Dim noBB As String, I As Long, ckF As String
'
noBB = "%|*\/:<>?"
For I = 1 To Len(noBB)
    cFN = Replace(cFN, Mid(noBB, I, 1), "", , , vbTextCompare)
Next I
If Right(cDir, 1) <> "\" Then cDir = cDir & "\"
ckF = cDir & cFN
I = 0
Do
    I = I + 1
    If Dir(ckF & ".msg") <> "" Then
        ckF = cDir & cFN & "(" & I & ")"
    Else
        If I > 100 Then
            ckF = cDir & "NON GESTIBILE"
        End If
        Exit Do
    End If
Loop
CreaFName = ckF & ".msg"
End Function

Il codice va in un Modulo standard del vba Outlook.
La riga marcata <<< va personalizzata con la directory in cui si salveranno i messaggi; la directory deve gia' esistere.

Prova...

keyw
save outlook message to disc
start script by rule

[johnatan69]

Sembra perfetta la testo un po' e ti faccio sapere.
Intanto grazie!!!

[johnatan69]

Funziona bene, tranne che per i file il cui nome supera i 256 caratteri.
Il debug mi evidenzia questa riga di comandi:
If Dir(ckF & ".msg") <> "" Then

[johnatan69]

Il limite di 260 caratteri è imposto da Windows 7 a quanto pare. Anche l'hotfix messo a disposizione da Microsoft non sembra risolvere il problema.
Il numero massimo di caratteri che può contenere l'oggetto di una mail Outlook è 255.
Quindi posso risolvere il problema salvando sulla dir c:\1.
Adesso l'unico errore che mi da lo script è quello indicato sopra, dovrei modificarlo ma non so bene cosa eliminare.
Credo di aver capito che c'è un istruzione che limita a 100 caratteri il nome file e dovrebbe non consentire la copia...
Penso vada rimossa. Anthony47 mi servirebbe la tua consulenza illuminante!
Grazie mille. (questo comando mi consentirà di andare in ferie tranquillo!!!)

[Anthony47]

Da quello che hai detto, bisogna sostituire queste due istruzioni al'interno della Function CreaFName

ckF = cDir & cFN

ckF = cDir & cFN & "(" & I & ")"

rispettivamente con

Codice: Seleziona tutto

ckF = left(cDir & cFN, 230)


Codice: Seleziona tutto

ckF = left(cDir & cFN,230) & "(" & I & ")"

Ovviamente sara' tua cura dichiarare una directory di partenza con pochi caratteri per lasciare piu' spazio al nome file.

Ciao

[johnatan69]

Fantastico. È perfetta. Grazie mille!

[johnatan69]

Torno alla carica.
Ogni tanto mi da un errore e la procedura si blocca evidenziando questa riga:

If Dir(ckF & ".msg") <> "" Then

Quale potrebbe essere la causa e quale la soluzione?

Grazie anticipatamente.

[Anthony47]

E quale e' il messaggio di errore?

[johnatan69]

Anthony ecco l'errore:
errore di run-time '-2147286788 °(800300fc)':

operazione non riuscita.

debug:
inMail.SaveAs fName, olMSG

Non riesco a capire qual'è l'evento scatenante, perché non è un errore che da sempre...

[Anthony47]

Quando sei in debug con l'istruzione evidenziata premi Contr-g per aprire la "finestra Immediata" del vba.
Qui digita

Codice: Seleziona tutto

?fName


Copia la risposta che ottieni e pubblicala nel prossimo messaggio.

Ciao

[johnatan69]

Uno dei file è questo.
C:\1\CONSEGNA I ACCETTAZIONE SLAS Prot 2018 0078376 - Parere XXXX XXXXXX "Xxxxxxx Xxxxxxxxxxxxxxxxxxx 'Xxxxxxxxxx Daniele e Xx Xxxxx Domenica' X.Xxx. 9999'17" Xxx.Xxxx. Xxxx. Xxxxxx [XXXX.9999.99999999.9999999].msg


Credo che il problema sia il carattere " che non è accettato nel nome file.
Ho modificato

Codice: Seleziona tutto

noBB = "%|*\/:<>?"

inserendo anche #e + ma ho il dubbio che aggiungendo il carattere " termino l'istruzione prima... o sbaglio?

(ho blankato i dati sensibili)

[Anthony47]

# e + sono caratteri accettati nel nome file.
Modifica

Codice: Seleziona tutto

noBB = "%|*\/:<>?" & chr(34) & chr(10)

Ciao

[johnatan69]

Provo e ti faccio sapere. Grazie mille

[johnatan69]

Ciao Anthony.
Il precedente problema sembra superato.
Adesso per mi capita questo errore:


La riga evidenziata è:
If Dir (ckF & ".msg") <> "" Then


Soluzioni?
Grazie sempre per la tua disponibilità!

[Anthony47]

Vai in debug, attiva la "finestra Immediata" (tramite Contr-g) e scrivi

Codice: Seleziona tutto

?ckf

Pubblica nel prossimo messaggio che cosa ti risponde.

Ciao

[johnatan69]

Ecco l'errore:

Codice: Seleziona tutto

C:\1\POSTA CERTIFICATA Richiesta di xxxxxxx xxxx xxxx ai sensi dell'art. 99999 - XX XXXXX   XXXXXXXX



[Anthony47]

Quell'errore e' tipico di quando il nome file e' non interpretabile da windows perche' contiene caratteri vietati; purtroppo nella stringa non vedo nessun carattere vietato, non so aiutarti.