Newsgroup: it.comp.lang.visual-basic
Titolo: Messaggi outlook salvati in access

Qualche settimana fa sono  sicuro di aver letto un messaggio in cui veniva 
indicata una routine per salvare le mail di outlook in un file access 
tramite visual basic.
Non lo riesco piu' a trovare ... google nemmeno ...
Qualche aiuto ?
grazie
Adriano 

 ha scritto nel messaggio 
news:T7Fhf.17672$tc5....@tornado.fastwebnet.it...

Codice Postato da Alessandro Baraldi ( io non l'ho provato pero')
Importer les messages d'un dossier Outlook dans une table
Si la table d'importation n'existe pas, elle est créée par requête SQL
Sub ImportMails()
On Error Resume Next
Dim strAttachment As String
Dim strSql As String
Dim rsMail As DAO.Recordset
Dim tdf As DAO.TableDef
Dim Ol_App As New Outlook.Application
Dim Ol_MAPI As Outlook.NameSpace
Dim Ol_Folder As Outlook.MAPIFolder
Dim Ol_Items As Outlook.MailItem
Dim Ol_Attach As Outlook.Attachment
Set tdf = CurrentDb.TableDefs("TblMails")
If tdf Is Nothing Then
    strSql = "CREATE TABLE TblMails (" & _
        "CreationTime DATE," & _
        "LastModificationTime DATE," & _
        "SenderName CHAR(50)," & _
        "SenderAddress CHAR(50)," & _
        "SentOn DATE," & _
        "Sent YESNO," & _
        "TO CHAR(255)," & _
        "CC CHAR(255)," & _
        "BCC CHAR(255)," & _
        "UnRead YESNO," & _
        "ReceivedByName CHAR(50)," & _
        "ReceivedOnBehalfOfName CHAR(100)," & _
        "ReceivedTime DATE," & _
        "ConversationTopic CHAR(255)," & _
        "Subject CHAR(255)," & _
        "Categories CHAR(50)," & _
        "HTMLBody MEMO," & _
        "Size Long," & _
        "Attachments CHAR(255));"
        CurrentDb.Execute strSql
End If
Set rsMail = CurrentDb.OpenRecordset("TblMails")
Set Ol_MAPI = Ol_App.GetNamespace("MAPI")
Set Ol_Folder = Ol_MAPI.PickFolder
  For Each Ol_Items In Ol_Folder.Items
     For Each Ol_Attach In Ol_Items.Attachments
      strAttachment = strAttachment & Ol_Attach.DisplayName & vbCrLf
     Next Ol_Attach
   With rsMail
    .AddNew
    .Fields("BCC") = Ol_Items.Bcc
    .Fields("Categories") = Ol_Items.Categories
    .Fields("CC") = Ol_Items.CC
    .Fields("ConversationTopic") = Ol_Items.ConversationTopic
    .Fields("CreationTime") = Ol_Items.CreationTime
    .Fields("HTMLBody") = Ol_Items.HTMLBody
    .Fields("LastModificationTime") = Ol_Items.LastModificationTime
    .Fields("ReceivedByName") = Ol_Items.ReceivedByName
    .Fields("ReceivedOnBehalfOfName") = Ol_Items.ReceivedOnBehalfOfName
    .Fields("ReceivedTime") = Ol_Items.ReceivedTime
    .Fields("SenderName") = Ol_Items.SenderName
    .Fields("Sent") = Ol_Items.Sent
    .Fields("SentOn") = Ol_Items.SentOn
    .Fields("SenderAddress") = Ol_Items.Reply.Recipients.Item(1).Address
    .Fields("Size") = Ol_Items.Size
    .Fields("Subject") = Ol_Items.Subject
    .Fields("TO") = Ol_Items.To
    .Fields("UnRead") = Ol_Items.UnRead
    .Fields("Attachments") = strAttachment
    .Update
   End With
   strAttachment = ""
 Next Ol_Items
rsMail.Close
MsgBox "Messaggi importati"
Set rsMail = Nothing
Set tdf = Nothing
Set Ol_Attach = Nothing
Set Ol_Items = Nothing
Set Ol_Folder = Nothing
Set Ol_MAPI = Nothing
Set Ol_App = Nothing
End Sub