RINOMINARE E SALVARE ALLEGATI MAIL OUTLOOK

[christianghz]

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]

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


[Anthony47]

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