Esportare posta da outlook ad access 2010

Question

Buonasera a tutti, in rete ho trovato il codice che vi allego e che dovrebbe copiarmi nel mio database la cartella che seleziono da Outlook. Tuitto funziona bene fio a questa riga di codce:Set Conn = CreateObject("DAO.Connection") che si colora di giallo e mi fa comparire il seguente messaggio :Errore di Runtime 429 il componente ActiveX non è in grado di creare l'oggetto. 

Ho controllato la librearia Dao  e risulta attivata.

Mi spiegate, per favore, a cosa si riferisce l'errore che vi segnalo?

Grazie per il vostro aiuto, colgo l'occasione per salutarVi ed augurarVi un sereno e Santo Natale.

Ciao,Nicola.

Sub EsportaPosta()

Dim ns As Outlook.NameSpace

Dim objFolder As Outlook.MAPIFolder

Set ns = GetNamespace("MAPI")

Set objFolder = ns.PickFolder

Dim Conn As DAO.Connection

Dim RS As DAO.Recordset

Dim intCounter As Integer

Set Conn = CreateObject("DAO.Connection")

Set RS = CreateObject("DAO.Recordset")

Conn.OpenRecordset "DSN=DatiOutlook;"

'RS.OpenRecordset "SELECT * FROM email", adoConn, adOpenDynamic, adLockOptimistic

For intCounter = objFolder.Items.Count To 1 Step -1

With objFolder.Items(intCounter)

If .Class = olMail Then

RS.AddNew

RS("Subject") = .Subject

RS("Body") = .Body

RS("FromName") = .SenderName

RS("ToName") = .To

RS("FromAddress") = .SenderEmailAddress

RS("FromType") = .SenderEmailType

RS("CCName") = .CC

RS("BCCName") = .BCC

RS("Importance") = .Importance

RS("Sensitivity") = .Sensitivity

RS.Update

End If

End With

Next

RS.Close

Set RS = Nothing

Set Conn = Nothing

Set ns = Nothing

Set objFolder = Nothing

End Sub

Answer 1

ciao Nicola,

credo che tu abbia un po' pasticciato tra Dao e Ado per con il codice è impostato....

prova un po' il codice che segue lanciando la sub ImportMails, l'avevo presa da un sito francese ora non trovo più il link.

Utilizza la tecnica dell'associazione anticipata quindi occhio ai riferimenti nel tuo DB, e se devi utilizzarla in pc con configurazioni diverse rifletti se modificare in tardiva.

Qualche tempo fa quando avevo tempo e voglia di sviluppare qualcosa avevo realizzato questa routine, se hai tempo e voglia dacci un occhio--->6.196 Esportare, importare o cancellare i contatti di Outlook da VBA del sito comune : http://web.mclink.it/MC5884/, visto il tuo interesse sull'automazione magari ti può essere d'aiuto.

un saluto e buon Natale a te e Famiglia.

Ciao, Sandro.

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 "Les données ont été importées"

 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

Answer 2

Buon pomeriggio  a tutti, un augurio di un sereno e felice 2015  a voi  e ai vostri cari.

Ciao Mimmo,  ciao Sandro, vi ringrazio per il vostro prezioso intervento.

Complimenti Sandro per il tuo codice brillante, era quello che da tempo ho cercato e non sono riuscito a mettere sui con le mie capacità.

Vi saluto  con sincerità, affetto  e grandissima stima.

Answer 3

Ciao Nicola,

Non sono in grado di verificare il codice da casa perchè ho Access 2007 e non ho Outlook.

In alternativa al codice postato hai provato a collegarti le cartelle da Outlook?

Se effettui il collegamento vedi la cartella di Outlook come una tabella.