Salvataggio Posta Outlook - InBox

 

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


______________________________________________________________________

 

Pag: <<    <    >    >>