In molte aziende viene utilizzato come client di posta Outlook del pacchetto Office. E' possibile interagire con gli oggetti di Outlook tramite le API che Microsoft mette a disposizione.
Qui di seguito inserisco un codice di esempio per il salvataggio delle mail in formato testo e degli allegati.
'********************************************
'* OUTLOOK - SALVATAGGIO MESSAGGI RICEVUTI *
'********************************************
Dim MyOL, objNS, objFolder, MyListItemsInbox, colFilteredItems, objIMail
Dim MeseRif, DataDA, DataA, AnnoRif, FolderName
Dim fso, MyFolder, Resp, PathIniziale
'Tabella .GetDefaultFolder(n)
'3 --> Deleted Items
'4 --> Outbox
'5 --> Sent Items
'6 --> Inbox
'9 --> Calendar
'10 --> Contacts
'11 --> Journal
'12 --> Notes
'13 --> Tasks
'16 --> Default Drafts folder
'18 --> All public folders collection
AnnoRif = inputBox ("Scegli l'anno di riferimento","Selta Anno", year(date))
if AnnoRif = "" then
wscript.Quit
end if
MeseRif = inputBox("Scegli il numero relativo al mese di riferimento di quest'anno:" & VbNewLine & VbNewLine & _
"1: Gennaio" & VbNewLine & _
"2: Febbraio"& VbNewLine & _
"3: Marzo" & VbNewLine & _
"4: Aprile" & VbNewLine & _
"5: Maggio" & VbNewLine & _
"6: Giugno" & VbNewLine & _
"7: Luglio" & VbNewLine & _
"8: Agosto" & VbNewLine & _
"9: Settembre" & VbNewLine & _
"10: Ottobre" & VbNewLine & _
"11: Novembre" & VbNewLine & _
"12: Dicembre", "Scelta Filtro Mese")
if MeseRif = "" then
wscript.quit
end if
Select Case MeseRif
Case 1:
DataDA = "31/12/" & AnnoRif-1
DataA = "01/02/" & AnnoRif
FolderName = "Gennaio_" & AnnoRif
Case 2:
DataDA = "31/01/" & AnnoRif
DataA = "01/03/" & AnnoRif
FolderName = "Febbraio_" & AnnoRif
Case 3:
DataDA = "28/02/" & AnnoRif
DataA = "01/04/" & AnnoRif
FolderName = "Marzo_" & AnnoRif
Case 4:
DataDA = "31/03/" & AnnoRif
DataA = "01/05/" & AnnoRif
FolderName = "Aprile_" & AnnoRif
Case 5:
DataDA = "30/04/" & AnnoRif
DataA = "01/06/" & AnnoRif
FolderName = "Maggio_" & AnnoRif
Case 6:
DataDA = "31/05/" & AnnoRif
DataA = "01/07/" & AnnoRif
FolderName = "Giugno_" & AnnoRif
Case 7:
DataDA = "30/06/" & AnnoRif
DataA = "01/08/" & AnnoRif
FolderName = "Luglio_" & AnnoRif
Case 8:
DataDA = "31/07/" & AnnoRif
DataA = "01/09/" & AnnoRif
FolderName = "Agosto_" & AnnoRif
Case 9:
DataDA = "31/08/" & AnnoRif
DataA = "01/10/" & AnnoRif
FolderName = "Settembre_" & AnnoRif
Case 10:
DataDA = "30/09/" & AnnoRif
DataA = "01/11/" & AnnoRif
FolderName = "Ottobre_" & AnnoRif
Case 11:
DataDA = "31/10/" & AnnoRif
DataA = "01/12/" & AnnoRif
FolderName = "Novembre_" & AnnoRif
Case 12:
DataDA = "30/11/" & AnnoRif
DataA = "01/01/" & AnnoRif+1
FolderName = "Dicembre_" & AnnoRif
Case else:
msgbox "Errore nella scelta del Mese. Esco dal programma", vbCritical + vbSystemModal, "Errore Mese"
wscript.quit
End Select
PathIniziale = "C:\Mail"
'********************************************************************************************************************
'Gestione del FileSystem
'Decido che le mail vengono salvate sotto "C:\Mail\Ricevute\Anno " & AnnoRif + la cartella del meseanno di riferimento
'che creo man mano se non esiste già.
'********************************************************************************************************************
Set fso = CreateObject("Scripting.FileSystemObject")
'Controllo l'esistenza della folder Mail sotto il PathIniziale e se non c'è la creo.
if Not(fso.FolderExists(PathIniziale)) then
fso.CreateFolder PathIniziale
end if
'aggiungo a PathIniziale la cartella "\Ricevute"
PathIniziale = PathIniziale & "\Ricevute"
'Controllo l'esistenza della folder Ricevute sotto il PathIniziale e se non c'è la creo.
if Not(fso.FolderExists(PathIniziale)) then
fso.CreateFolder PathIniziale
end if
'aggiungo a PathIniziale la cartella dell'anno di riferimento
PathIniziale = PathIniziale & "\Anno " & AnnoRif
'Controllo l'esistenza della folder Ricevute sotto il PathIniziale e se non c'è la creo.
if Not(fso.FolderExists(PathIniziale)) then
fso.CreateFolder PathIniziale
end if
if Not(fso.FolderExists(PathIniziale & "\" & FolderName)) then
fso.CreateFolder PathIniziale & "\" & FolderName
end if
Set fso = Nothing
Set MyOL = CreateObject("Outlook.Application")
Set objNS = MyOL.GetNameSpace("MAPI")
Set objFolder = objNS.GetDefaultFolder(6) 'InBox
Set MyListItemsInbox = objFolder.Items
Set colFilteredItems = MyListItemsInbox.Restrict("[Ricevuto] > '" & DataDA & "' And [Ricevuto] < '" & DataA & "'")
msg = ""
for i=1 to colFilteredItems.Count
set objIMail = colFilteredItems.Item(i)
on error resume next
objIMail.SaveAs PathIniziale & "\" & FolderName & "\Mail_" & objIMail.SentOnBehalfOfName & "_" & i & ".txt", olTXT
if err.number = 0 then
'Salvo eventuali allegati
set ListAtt = objIMail.Attachments
if ListAtt.Count > 0 then
for j=1 to ListAtt.Count
msg = msg & objIMail.SentOnBehalfOfName & "_" & i & vbTab & vbTab & vbTab & "#allegati: " & ListAtt.Count & vbNewLine
ListAtt.Item(j).SaveAsFile PathIniziale & "\" & FolderName & "\AttachMail_" & objIMail.SentOnBehalfOfName & "_" & i & "_" &
ListAtt.Item(j).DisplayName
next
end if
set ListAtt = Nothing
'if Resp = vbOK then
' objIMail.Delete
'end if
end if
on error goto 0
set objIMail = Nothing
next
msgbox "Salvate le mail per il mese di " & FolderName & " sotto il seguente percorso:" & vbNewLine & PathIniziale & "\" & FolderName , vbInformation + vbSystemModal, "Fine
Programma Salvataggio Mail"
msgbox "Salvati anche gli allegati per i seguenti messaggi: " & vbNewLine & msg,vbInformation + vbSystemModal, "Dettaglio allegati"
Set colFilteredItems = Nothing
Set MyListItemsInbox = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set MyOL = Nothing
______________________________________________________________________