Condividi:        

Outlook: Salvare Allegati in PDF in automatico e rinominarli

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

Outlook: Salvare Allegati in PDF in automatico e rinominarli

Postdi Making » 13/09/21 17:34

Ciao e grazie come sempre.

A completamento di quanto ti ho chiesto in precedenza vorrei sapere se è possibile creare una macro in outlook (io uso 365) che salvi ogni giorno una ventina di allegati in pdf in una cartella chiamata PDF. I file mi arrivano sempre dalle stesse email ma a volte con nomi diversi per cui da ogni email devo scaricare il pdf sul PC e dargli sempre lo stesso nome. Ad esempio, l'email che mi arriva da Torino scaricherà il file che nominerà tor.pdf, quello di Milano mil.pdf ecc. Ad oggi ne ho circa una ventina al giorno ma potrebbero crescere quindi bisogna tenere conto anche di questo incremento che in qualche modo va' gestito.

Ho visto qualcosa nel forum ma si riferiva a file .xls. Infine, non so come si abilita, come si scrive e come si lanca la VBA su outlook, grazie in anticipo.
Making
Utente Junior
 
Post: 49
Iscritto il: 22/07/15 12:50

Sponsor
 

Re: Outlook: Salvare Allegati in PDF in automatico e rinomin

Postdi Anthony47 » 14/09/21 01:28

Una discussione molto simile alla tua e' questa:
viewtopic.php?f=26&t=110711
Quella soluzione scansiona tutte le mail contenute in un folder specificato, verifica che provenga da un certo mittente e che abbia un certo Subject; controlla se ha un allegato "pdf" ed eventualmente lo salva in un percorso indicato assegnandgli un nome in formato yyyy-mm-dd_timer.pdf; infine sposta l'email in un altro folder specificato.

Il modello vba di Outlook e' simile a quello di Excel (vedi viewtopic.php?f=26&t=103893&p=647675#p647675); accedi al progetto vba sempre tramite Alt-F11; la macro va inserita in un Modulo standard che va aggiunto tramite il comando Menu /Inserisci /Modulo

Per eseguirla puoi personalizzare la barra di accesso rapido di Outlook aggiungendogli una icona che avvii la tua macro, esattamente come descritto per Excel qui: viewtopic.php?f=26&t=103893&p=647679#p647679

Vedi dove arrivi, noi siamo qui
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Outlook: Salvare Allegati in PDF in automatico e rinomin

Postdi Making » 15/09/21 12:24

Ciao grazie, devo dire che questa è più difficile. In ogni caso l'ho adattata alle mie cartelle e lanciandola si ferma all'istruzione "Set myMex = daProc.Items(J)" restituendo l'errore di run-time 13, Tipo non corrispondente. Cosa vuo, dire?
Making
Utente Junior
 
Post: 49
Iscritto il: 22/07/15 12:50

Re: Outlook: Salvare Allegati in PDF in automatico e rinomin

Postdi Anthony47 » 15/09/21 13:46

Vai in cima al codice; modifica quel myMex As MailItem in myMex as Variant

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

Re: Outlook: Salvare Allegati in PDF in automatico e rinomin

Postdi Making » 15/09/21 16:40

Grazie ho corretto. Mi sono inviato una mail l'allegato AAA.pdf che ho messo nella cartella "Sales".
Sembra girare tutto ma non sposta nulla, nel recap finale mi dice:

Completato ...
Messaggi esaminati: 1
Totale file salvati: 0
Messaggi esaminati ma non spostati: 1

Questa è la macro:

Codice: Seleziona tutto
Sub WorkAllFrom()
'http://www.pc-facile.com/forum/viewtopic.php?f=26&t=110711&p=649928#p649928
Dim daProc As MAPIFolder, Procd As MAPIFolder
Dim myNameSpace As NameSpace, myMex As Variant
Dim I As Long, BasePath As String, PS As String
Dim DayPath As String, J As Long, AttCnt As Long, mWAtt As Long, fCnt As Long, mTot As Long
Dim AName As String, myTim As Single, eDel As Single, flXls As Boolean, mRes As Long
Dim mSender, tAdr As String, fTipo As String
Dim bName As String, tSubj As String
'
Set myNameSpace = Application.GetNamespace("MAPI")
'
Set daProc = myNameSpace.Folders("pippo@aaa.com").Folders("Sales")                           '<<<Folder di origine
Set Procd = myNameSpace.Folders("pippo@aaa.com").Folders("Vendite")        '<<< Folder di spostamento
BasePath = "C:\Prova\"   '<<< La directory di salvataggio allegati
'
PS = "\"
DayPath = Format(Now, "yyyy-mm-dd")
If Right(BasePath, 1) <> PS Then BasePath = BasePath & PS
'
tAdr = "pippo@"            '<<< Mittente
fTipo = ".pdf"                '<<< Tipo di file
tSubj = "Vendite"            '<<< Subject della mail
'
mTot = daProc.Items.Count
For J = daProc.Items.Count To 1 Step -1
    Set myMex = daProc.Items(J)
    flXls = False
    If TypeOf myMex Is MailItem Then
        mSender = myMex.SenderName
        If InStr(1, mSender, tAdr, vbTextCompare) > 0 Then
            myTim = Timer
            AttCnt = myMex.Attachments.Count
            If AttCnt > 0 Then
                For I = 1 To AttCnt
                    AName = myMex.Attachments(I).DisplayName
                    If UCase(Right(AName, Len(fTipo))) = UCase(fTipo) And _
                      InStr(1, myMex.Subject, tSubj, vbTextCompare) > 0 Then
                        bName = DayPath & "_" & Format(Timer, "00000") & fTipo
                        'se file PDF, salva allegato:
                        fCnt = fCnt + 1
                        myMex.Attachments(I).SaveAsFile BasePath & bName
                        flXls = True
                        'eventuale attesa per >1 sec:
                        If (Timer - myTim) < 1 Then
                            eDel = (myTim + 1.5 - Timer)
                            myWait (eDel)
                        End If
                    End If
                Next I
            End If
            If flXls Then mWAtt = mWAtt + 1
            'Sposta messaggio:
            myMex.Move Procd
        End If
    End If
Next J
mRes = daProc.Items.Count       'Itm residui (non mailItems)
MsgBox ("Completato... " & vbCrLf & "Messaggi esaminati: " & mTot _
    & vbCrLf & "Mail (spostate) con allegati: " & mWAtt _
    & vbCrLf & "Totale file salvati: " & fCnt _
    & vbCrLf & "Messaggi esaminati ma non spostati: " & mRes)
End Sub

Sub myWait(ByVal myStab As Single)
Dim myStTiM As Single
'
    myStTiM = Timer
    Do          'wait myStab
        DoEvents
        If Timer > myStTiM + myStab Or Timer < myStTiM Then Exit Do
    Loop
End Sub
Making
Utente Junior
 
Post: 49
Iscritto il: 22/07/15 12:50

Re: Outlook: Salvare Allegati in PDF in automatico e rinomin

Postdi Anthony47 » 15/09/21 19:17

Modifica la macro come segue:
Codice: Seleziona tutto
Sub WorkAllFrom()
'http://www.pc-facile.com/forum/viewtopic.php?f=26&t=110711&p=649928#p649928
Dim daProc As MAPIFolder, Procd As MAPIFolder
Dim myNameSpace As Namespace, myMex As Variant
Dim I As Long, BasePath As String, PS As String
Dim DayPath As String, J As Long, AttCnt As Long, mWAtt As Long, fCnt As Long, mTot As Long
Dim AName As String, myTim As Single, eDel As Single, flXls As Boolean, mRes As Long
Dim mSender, tAdr As String, fTipo As String
Dim bName As String, tSubj As String
'
Set myNameSpace = Application.GetNamespace("MAPI")
'
Set daProc = myNameSpace.Folders("pippo@aaa.com").Folders("Sales")                           '<<<Folder di origine
Set Procd = myNameSpace.Folders("pippo@aaa.com").Folders("Vendite")        '<<< Folder di spostamento
BasePath = "C:\Prova\"   '<<< La directory di salvataggio allegati
'
PS = "\"
DayPath = Format(Now, "yyyy-mm-dd")
If Right(BasePath, 1) <> PS Then BasePath = BasePath & PS
'
tAdr = "pippo@"            '<<< Mittente
fTipo = ".pdf"                '<<< Tipo di file
tSubj = "Vendite"            '<<< Subject della mail
'
mTot = daProc.Items.Count
Debug.Print "A", mTot
For J = daProc.Items.Count To 1 Step -1
    Debug.Print ">>>"
    Set myMex = daProc.Items(J)
    flXls = False
    Debug.Print "B", J
    If TypeOf myMex Is MailItem Then
        Debug.Print "C", J, myMex.SenderName
        mSender = myMex.SenderName
        If InStr(1, mSender, tAdr, vbTextCompare) > 0 Then
            Debug.Print "D", J, "Pass"
            myTim = Timer
            AttCnt = myMex.Attachments.Count
            Debug.Print "E", J, AttCnt
            If AttCnt > 0 Then
                For I = 1 To AttCnt
                    AName = myMex.Attachments(I).DisplayName
                    Debug.Print "E" & I, J, AName
                    If UCase(Right(AName, Len(fTipo))) = UCase(fTipo) And _
                      InStr(1, myMex.Subject, tSubj, vbTextCompare) > 0 Then
                        Debug.Print "EE" & I, J, "Pass", flXls
                        bName = DayPath & "_" & Format(Timer, "00000") & fTipo
                        'se file PDF, salva allegato:
                        fCnt = fCnt + 1
                        myMex.Attachments(I).SaveAsFile BasePath & bName
                        flXls = True
                        'eventuale attesa per >1 sec:
                        If (Timer - myTim) < 1 Then
                            eDel = (myTim + 1.5 - Timer)
                            myWait (eDel)
                        End If
                    End If
                Next I
            End If
            If flXls Then mWAtt = mWAtt + 1
            'Sposta messaggio:
            myMex.Move Procd
        End If
    End If
Next J
mRes = daProc.Items.Count       'Itm residui (non mailItems)
MsgBox ("Completato... " & vbCrLf & "Messaggi esaminati: " & mTot _
    & vbCrLf & "Mail (spostate) con allegati: " & mWAtt _
    & vbCrLf & "Totale file salvati: " & fCnt _
    & vbCrLf & "Messaggi esaminati ma non spostati: " & mRes)
End Sub

Sub myWait(ByVal myStab As Single)
Dim myStTiM As Single
'
    myStTiM = Timer
    Do          'wait myStab
        DoEvents
        If Timer > myStTiM + myStab Or Timer < myStTiM Then Exit Do
    Loop
End Sub

Ho aggiunto la stampa di alcune informazioni di debug

Quando la macro si completa vai sul vba; apri la "Finestra Immediata" (premendo Contr-g dovrebbe aprirsi automaticamente); copia quanto vi e' scritto e pubblicalo nel tuo prox messaggio.
Attenzione: potrebbero esserci informazioni che preferisci tenere riservate; in questo caso sostituisci i caratteri che vuoi nascondere con * (asterisco) purche' il risultato sia intellegibile (un * ogni crt da nascondere)

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

Re: Outlook: Salvare Allegati in PDF in automatico e rinomin

Postdi Making » 16/09/21 12:16

A 1
Grazie, eccolo, fammi sapere.

Codice: Seleziona tutto
>>>
B              1
C              1            ****** ********
A              1
>>>
B              1
C              1            ****** ********
Making
Utente Junior
 
Post: 49
Iscritto il: 22/07/15 12:50

Re: Outlook: Salvare Allegati in PDF in automatico e rinomin

Postdi Anthony47 » 16/09/21 13:01

Allora...
Vedo che hai provato 2 volte
Il folder conteneva 1 solo messaggio
Il mittente e' ****** ********
Il mittente non quaglia con quanto hai scritto nella variabile tAdr (nel codice pubblicato c'e' scritto pippo@), quindi la mail viene ignorata e si passa alla prossima mail
Fine

Quindi la macro non riconosce il mittente come mittente dichiarato da intercettare e la mail viene ignorata
Devi guardare in quel ****** ******** per capire come dichiarare il mittente

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

Re: Outlook: Salvare Allegati in PDF in automatico e rinomin

Postdi Making » 16/09/21 15:04

Sistemata, forse cambiano il ome in **** non l'avevo cambiata ma si tratta dello stessoi indirizzo email. Continua a non funzionare.
Making
Utente Junior
 
Post: 49
Iscritto il: 22/07/15 12:50

Re: Outlook: Salvare Allegati in PDF in automatico e rinomin

Postdi Anthony47 » 16/09/21 16:19

Se continua a non funzionare e serve il mio aiuto mi devi mandare il nuovo log...
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Outlook: Salvare Allegati in PDF in automatico e rinomin

Postdi Making » 16/09/21 18:04

A 1
>>>
B 1
C 1 xxx.xxxxxxxx@xxx.xx
A 1
>>>
B 1
C 1 xxx.xxxxxxxx@xxx.xx
Making
Utente Junior
 
Post: 49
Iscritto il: 22/07/15 12:50

Re: Outlook: Salvare Allegati in PDF in automatico e rinomin

Postdi Anthony47 » 16/09/21 18:54

Stessa storia:
La componente che scrivi in tAdr="xyzmn" non e' presente nell'indirizzo del mittente (xxx.xxxxxxxx@xxx.xx); la mail viene ignorata.

Guarda quel xxx.xxxxxxxx@xxx.xx e compila tAdr con lo stesso valore: tAdr = "xxx.xxxxxxxx"
Se vuoi ignorare in toto l'indirizzo del mittente usa tAdr="@"; oppure uso solo il domino, es tAdr="@ibm.com"

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


Torna a Applicazioni Office Windows


Topic correlati a "Outlook: Salvare Allegati in PDF in automatico e rinominarli":


Chi c’è in linea

Visitano il forum: Nessuno e 36 ospiti