In this article we continue to see Outlook e-mail management. This part is about the saving of e-mail element that have been sent.

 

'********************************************
'*             OUTLOOK - SAVE SENT MESSAGE                  *
'********************************************
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\Sent\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 sent folder to pathiniziale
PathIniziale = PathIniziale & "\Sent"
if Not(fso.FolderExists(PathIniziale)) then
 fso.CreateFolder PathIniziale
end if

 

'add year folder
PathIniziale = PathIniziale & "\Year " & AnnoRif
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(5)  'SentItems

Set MyListItemsInbox = objFolder.Items
Set colFilteredItems = MyListItemsInbox.Restrict("[Sent] > '" & DataDA & "' And [Sent] < '" & DataA & "'")

msg = ""
for i=1 to colFilteredItems.Count

 set objIMail = colFilteredItems.Item(i)
 

 on error resume next

 objIMail.SaveAs PathIniziale & "\" & FolderName & "\Mail_" & objIMail.To & "_" & 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.To & "_" & 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 "Save mail for the month " & FolderName & " under this path:" & vbNewLine & PathIniziale & "\" & FolderName , vbInformation + vbSystemModal, "End Program Mail Saving"

msgbox "Save also attachments 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: <<    <    >    >>