Una macro che mostra come sia semplice leggere le mail nella cartella posta di in arrivo di Outlook e riportarle in Excel.
Uno degli esempi tipici di un file del genere è quando si ricevono un gran numero di moduli simili allegati alle mail, in questo caso è molto comodo leggere le mail ed estrarne i dati in Excel; l'esempio classico sono gli ordini inviati che arrivano su foglio di calcolo.
 Lo scopo è avere un elenco delle mail presenti nella cartella posta in arrivo in una tabella simile a quella qui a lato. |
In realtà per rendere davvero utilizzabile uno strumento del genere dovremmo aggiungere la lettura degli allegati e lo spostamento delle mail processate in altra cartella, ma procediamo per gradi.
La procedura legge le mail (le prime NrRigheMax) dalla cartella posta in arrivo ordinate per data (ultima per prima) e le riporta nell'elenco. Per rendere più semplice la lettura del testo in Excel vengono tolti, dal testo del messaggio, gli a-capo multipli.
Sub LeggiMailDaInbox()
' Libreria: Strumenti --> Riferimenti--> Microsoft Outlook x.xx Object Library
Dim xOutApp
As Outlook.
Application
Dim xOutNameSpace
As Outlook.Namespace
Dim xOutFolder
As Outlook.Folder
Dim xOutItems
As Outlook.Items
Dim xOutMail
As Outlook.MailItem
Ra = 5
NrRigheMax = 20
' cancella l'elenco precendente
Set Fa =
ActiveSheet
Ur = Fa.
Cells(
Rows.Count, "B").End(xlUp).Row
If (Ur >= Ra)
Then
Rows(Ra & ":" & Ur).Delete Shift:=xlUp
End If
Set xOutApp = CreateObject("Outlook.
Application")
Set xOutNameSpace = xOutApp.GetNamespace("MAPI")
Set xOutFolder = xOutNameSpace.GetDefaultFolder(olFolderInbox)
Set xOutItems = xOutFolder.Items
xOutItems.Sort "ReceivedTime", True
For Each xOutMail
In xOutItems
Fa.
Cells(Ra, 2) = xOutMail.ReceivedTime
Fa.
Cells(Ra, 3) = xOutMail.Sender
Fa.
Cells(Ra, 4) = xOutMail.Subject
' body
Body = xOutMail.Body
' toglie gli a-capo multipli dal corpo del messaggio
' per rendere più semplice la lettura all'interno delle celle
While (
InStr(Body,
vbNewLine +
vbNewLine) > 0)
Body =
Replace(Body,
vbNewLine +
vbNewLine,
vbNewLine)
Wend
Fa.
Cells(Ra, 5) = Body
Ra = Ra + 1
' verifica se ha superato il numero massimo di mail da leggere
NrRigheMax = NrRigheMax - 1
If (NrRigheMax <= 0)
Then Exit For
Next xOutMail
End Sub
In
questo articolo potete trovare la parte di codice necessaria per leggere gli allegati presenti ed eventualmente salvarli nel proprio pc; la abbiamo messa separata qui per rendere più semplice la lettura del codice.
Gli esempi contenuti nel sito sono per uso personale, non é consentito l'uso professionale, commerciale o la riproduzione senza autorizzazione.
