Several companies use, as mail client, Outlook of the Microsoft Office package. It is possible to manage Outlook object within the API that Microsoft provides.

 

Here is a sample to save the received e-mails, in text format, and the attachments.

 

 

'********************************************
'*  OUTLOOK - SAVE RECEIVED MESSAGGES                    *
'********************************************
Dim MyOL, objNS, objFolder, MyListItemsInbox, colFilteredItems, objIMail
Dim MeseRif, DataDA, DataA, AnnoRif, FolderName
Dim fso, MyFolder, Resp, PathIniziale

' .GetDefaultFolder(n) Table
'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 ("Choose the Year ","YEAR", year(date))
if AnnoRif = "" then
 wscript.Quit
end if

MeseRif = inputBox("Choose the number of the month:" & VbNewLine & VbNewLine & _
     "1:  Jan" & VbNewLine & _
     "2:  Feb"& VbNewLine & _
     "3:  Mar" & VbNewLine & _
     "4:  Apr" & VbNewLine & _
     "5:  May" & VbNewLine & _
     "6:  Jun" & VbNewLine & _
     "7:  Jul" & VbNewLine & _
     "8:  Ago" & VbNewLine & _
     "9:  Sep" & VbNewLine & _
     "10: Oct" & VbNewLine & _
     "11: Nov" & VbNewLine & _
     "12: Dec", "Scelta Filtro Mese")

if MeseRif = "" then
 wscript.quit
end if

 

'DataDA = FromDate

'DataA = ToDate

 

 

Select Case MeseRif

 Case 1:
  DataDA = "12/31" & AnnoRif-1
  DataA  = "02/01" & AnnoRif
  FolderName = "Jan_" & AnnoRif

 Case 2:
  DataDA = "01/31" & AnnoRif
  DataA  = "03/01" & AnnoRif
  FolderName = "Feb_" & AnnoRif  

 Case 3:
  DataDA = "02/28" & AnnoRif
  DataA  = "04/01" & AnnoRif
  FolderName = "Mar_" & AnnoRif

 Case 4:
  DataDA = "03/31" & AnnoRif
  DataA  = "05/01" & AnnoRif  
  FolderName = "Apr_" & AnnoRif

 Case 5:
  DataDA = "04/30" & AnnoRif
  DataA  = "06/01" & AnnoRif
  FolderName = "May_" & AnnoRif

 Case 6:
  DataDA = "05/31" & AnnoRif
  DataA  = "07/01" & AnnoRif
  FolderName = "Jun_" & AnnoRif

 Case 7:
  DataDA = "06/30" & AnnoRif
  DataA  = "08/01" & AnnoRif
  FolderName = "Jul_" & AnnoRif

 Case 8:
  DataDA = "07/31" & AnnoRif
  DataA  = "09/01" & AnnoRif
  FolderName = "Ago_" & AnnoRif

 Case 9:
  DataDA = "08/31" & AnnoRif
  DataA  = "10/01" & AnnoRif  
  FolderName = "Sep_" & AnnoRif

 Case 10:
  DataDA = "09/30" & AnnoRif
  DataA  = "11/01" & AnnoRif
  FolderName = "Oct_" & AnnoRif

 Case 11:
  DataDA = "10/31" & AnnoRif
  DataA  = "12/01" & AnnoRif
  FolderName = "Nov_" & AnnoRif

 Case 12:
  DataDA = "11/30" & AnnoRif
  DataA  = "01/01" & AnnoRif+1
  FolderName = "Dec_" & AnnoRif

 Case else:
  msgbox "Error in Month Choosing. Quit", vbCritical + vbSystemModal, "Error"
  wscript.quit

End Select

 

 

PathIniziale = "C:\Mail"

'********************************************************************************************************************
'FileSystem Management
'Mails are saved under "C:\Mail\Riceived\Year " & AnnoRif +

'monthyear folder rif

'that I create if it doesn't exist.
'********************************************************************************************************************
Set fso = CreateObject("Scripting.FileSystemObject")

'Check the existence of Mail folder Mail under starting Path (PathIniziale).

'If it doesn't exist I'll create it.
if Not(fso.FolderExists(PathIniziale)) then
 fso.CreateFolder PathIniziale
end if

'add the folder "\Ricevute" to PathIniziale
PathIniziale = PathIniziale & "\Ricevute"
'Check if folder exists

if Not(fso.FolderExists(PathIniziale)) then
 fso.CreateFolder PathIniziale
end if

'add the yeat to PathIniziale string
PathIniziale = PathIniziale & "\Anno " & AnnoRif
'Check if it exists.
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("[Riceived] > '" & DataDA & "' And [Riceived] < '" & 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 

    'Attachment Saving
    set ListAtt = objIMail.Attachments
    if ListAtt.Count > 0 then 
      for j=1 to ListAtt.Count
  msg = msg & objIMail.SentOnBehalfOfName & "_" & i & vbTab & vbTab & vbTab & "#attachments: " & 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 "Mail saved for the month  " & FolderName & " under this path:" & vbNewLine & PathIniziale & "\" & FolderName , vbInformation + vbSystemModal, "End Program"

msgbox "Attachements has been saved for these messages: " & vbNewLine & msg,vbInformation + vbSystemModal, "Attachments Details"

Set colFilteredItems = Nothing
Set MyListItemsInbox = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set MyOL = Nothing

______________________________________________________________________

 

 

Pag: <<    <    >    >>