Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

RINOMINARE E SALVARE ALLEGATI MAIL OUTLOOK

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Re: RINOMINARE E SALVARE ALLEGATI MAIL OUTLOOK

Postdi christianghz » 15/03/18 00:37

Beh, che io "sappia" direi di no, io "provo"! :-)

Ho abbreviato i nomi delle cartelle nidificate ma in alcuni casi non basta.
Quindi ho provato ad abbreviare i nomi degli allegati così:
AName = Left (myMex.Attachments(I).DisplayName, 30)

Ma così facendo la macro processa le mail ma non archivia gli allegati.
Ad ora non ho capito perchè.
christianghz
Utente Senior
 
Post: 114
Iscritto il: 03/02/14 17:58

Sponsor
 

Re: RINOMINARE E SALVARE ALLEGATI MAIL OUTLOOK

Postdi christianghz » 15/03/18 12:01

Allora, ho capito.
"Leftando" l' Aname prima del Mysplit andavo a tagliare la desinenza del file e la macro non riconosceva i file come file xls (avendo troncato la desinenza .xls/.xlsx) e quindi non li salvava perchè non erano file xls appunto.

Quindi sono andato a modificare la cosa più giu, nel salvataggio degli allegati.
Pubblico per favorire chi verrà dopo di me se più ignorante di me (difficile) ma mi rendo conto da solo che, nonostante funga, fa schifo:
Codice: Seleziona tutto
   'se file xls, salva allegato:
                If InStr(1, mySplit(UBound(mySplit)), "xls", vbTextCompare) > 0 Then
                    fCnt = fCnt + 1
                   
                    If Right(AName, 4) = ".xls" Or Right(AName, 5) = ".xlsx" Then
                    myMex.Attachments(I).SaveAsFile DayPath & PS & AName
                        Else
                        myMex.Attachments(I).SaveAsFile DayPath & PS & AName & "-" & Format(Now, "hh-mm-ss") & "-" & Right(myMex.Attachments(I).DisplayName, 5)
                        End If
                   
                    flXls = True
                End If
christianghz
Utente Senior
 
Post: 114
Iscritto il: 03/02/14 17:58

Re: RINOMINARE E SALVARE ALLEGATI MAIL OUTLOOK

Postdi Anthony47 » 16/03/18 01:38

Allora, la limitazione e' ancora piu' severa, perche' Excel non e' in grado di gestire lunghezze totali del percorso e del nome file, inclusa l'estensione, superiori a 217 caratteri.
Quindi devi necessariamente accorciare alla grande i nomi delle directory che crei; ad esempio non ha senso ripetere 4 volte "moduli da processare".
Ribadendo che inizialmente (macro del 10-01 mattina presto) il percorso creato era AA-MM-GG (e puo' facilissimamente essere trasformato in AAAA-MM-GG), quindi secondo me ampiamente in grado di identificare il perido a cui i file sottostanti appartenevano, puoi almeno limitare il path a AAAA\mm\GG (es \2018\03\15); poi in ogni caso si limita la lunghezza complessiva per limitarla a 217 crt.
Tutto cio' si puo' fare con questo codice:
Codice: Seleziona tutto
YearPath = Format(Now, "yyyy") '<<< inizio mia modifica al codice
If Right(BasePath, 1) <> PS Then BasePath = BasePath & PS
YearPath = BasePath & YearPath
If Dir(YearPath, vbDirectory) = "" Then MkDir (YearPath)

MonthPath = Format(Now, "mm")
If Right(YearPath, 1) <> PS Then YearPath = YearPath & PS
MonthPath = YearPath & MonthPath
If Dir(MonthPath, vbDirectory) = "" Then MkDir (MonthPath)

DayPath = Format(Now, "dd")
If Right(MonthPath, 1) <> PS Then MonthPath = MonthPath & PS
DayPath = MonthPath & DayPath
If Dir(DayPath, vbDirectory) = "" Then MkDir (DayPath) '<<< fine mia modifica al codice

mTot = daProc.Items.Count
For J = daProc.Items.Count To 1 Step -1
'For Each myMex In daProc.Items
    Set myMex = daProc.Items(J)
    flXls = False
    If TypeOf myMex Is MailItem Then
        mSender = myMex.SenderName
cippaa = (myMex.SenderEmailAddress)
'bonifica Adr:
        For I = 1 To Len(noBB)
            mSender = Replace(mSender, Mid(noBB, I, 1), "#", , , vbTextCompare)
        Next I
        myTim = Timer
        AttCnt = myMex.Attachments.Count
        If AttCnt > 0 Then
            For I = 1 To AttCnt
                '"Sistema" il nome file:
                AName = myMex.Attachments(I).DisplayName
                mySplit = Split(" " & AName, ".", , vbTextCompare)
                If UBound(mySplit, 1) > 0 Then                        '<<< MODIFICATO IF per controllo lunghezza
                    AName = Left(mSender & "_" & Replace(AName, "." & mySplit(UBound(mySplit, 1)), "", , , vbTextCompare), 217 - Len(DayPath) - 15) & "_" & Format(Now, "hh-mm-ss") & "." & mySplit(UBound(mySplit, 1))
                Else
                    AName = Left(mSender & "_" & AName, 217 - Len(DayPath) - 15) & "_" & Format(Now, "hh-mm-ss")
                End If
                'se file xls, salva allegato:
                If InStr(1, mySplit(UBound(mySplit)), "xls", vbTextCompare) > 0 Then
                    fCnt = fCnt + 1
                    myMex.Attachments(I).SaveAsFile DayPath & PS & AName
                    flXls = True
                End If
            Next I
        Else
            'Niente?
        End If
        If flXls Then mWAtt = mWAtt + 1
        'Sposta messaggio:
        myMex.Move Procd
'eventuale attesa per >1 sec:
        If (Timer - myTim) < 1 Then
            eDel = (myTim + 1.5 - Timer)
            myWait (eDel)
        End If
    End If
'Next myMex
Next J

Sostituisce l'analogo blocco precedente.
La prima parte crea le directory coi nomi semplificati; nella seconda parte la modifica riguarda solo le istruzioni marcate con <<< MODIFICATO IF per controllo lunghezza, e cioe' If UBound(mySplit, 1) > 0 Then /End If

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17646
Iscritto il: 21/03/06 16:03
Località: Ivrea

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "RINOMINARE E SALVARE ALLEGATI MAIL OUTLOOK":


Chi c’è in linea

Visitano il forum: Nessuno e 64 ospiti