OVH Cloud OVH Cloud

recordset

1 réponse
Avatar
mbourbeau
J'ai utilisé les recordset il y a longtemps déjà, je ne me souviens
plus trop de la procédure. J'aimerais me servir des recordset pour
parcourir les champs de la table "mail".
Voici mon code:
Private Sub btnImportMail_Click()
'variables
Dim strFrom As String
Dim strTo As String
Dim strAttachment As String
Dim bAttachment As Boolean
Dim rsMail As Recordset

Set olapp = CreateObject("Outlook.Application")
Set objNameSpace = olapp.GetNamespace("MAPI")
Set objFolder = objNameSpace.PickFolder
Me.RecordSource = "mail"

For Each mail In objFolder.Items
strFrom = mail.SenderName
strTo = mail.To
strCc = mail.Cc
strSubject = mail.Subject
For Each attachs In mail.Attachments
strAttachment = strAttachment & attachs.DisplayName & vbCrLf
Next attachs
rsMail.Fields("To") = strTo
strAttachment = ""
rsMail.MoveNext
rsMail.AddNew
Next mail
End Sub

il me manque un petit qqc, si quelqu'un pouvait m'aider.
Merci

1 réponse

Avatar
Anor
Bonjour Archon

Bonjour aussi,

Voici le code un peu modifié à mettre dans un module à part
qui s'appellera par exemple BasImportMail

Sub ImportMail
'variables
Dim strFrom As String
Dim strTo As String
Dim strAttachment As String
Dim bAttachment As Boolean
Dim rsMail As dao.Recordset

Set OlApp = CreateObject("Outlook.Application")
Set objNameSpace = OlApp.GetNamespace("MAPI")
Set objFolder = objNameSpace.PickFolder

Set rsMail = CurrentDb.OpenRecordset("Mail")

For Each mail In objFolder.Items
strFrom = mail.SenderName
strTo = mail.To
strCC = mail.CC
strSubject = mail.subject
For Each attachs In mail.Attachments
strAttachment = strAttachment & attachs.DisplayName & vbCrLf
Next attachs
With rsMail
.AddNew
.Fields("From") = strFrom
.Fields("To") = strTo
.Fields("Cc") = strCC
.Fields("Subject") = strSubject
.Fields("Attachments") = strAttachment
.Update
End With
strAttachment = ""
Next mail
rsMail.Close
Set rsMail = Nothing
End Sub

Et à appeler depuis le bouton de n'importe quel formulaire en faisant :

Private Sub btnImportMail_Click()
Call ImportMail()
End Sub

ps : on doit pouvoir simplifier quelques déclarations de variables pas forcément indispensables.

--
à+
Arnaud
----------------------------------------------
Conseils d'utilisation, sites recommandés :
http://users.skynet.be/mpfa/
Access Memorandum - Les tablettes d'Anor
www.anor.fr.st
----------------------------------------------

Archon a médité :
| J'ai utilisé les recordset il y a longtemps déjà, je ne me souviens
| plus trop de la procédure. J'aimerais me servir des recordset pour
| parcourir les champs de la table "mail".
| Voici mon code:
| Private Sub btnImportMail_Click()
| 'variables
| Dim strFrom As String
| Dim strTo As String
| Dim strAttachment As String
| Dim bAttachment As Boolean
| Dim rsMail As Recordset
|
| Set olapp = CreateObject("Outlook.Application")
| Set objNameSpace = olapp.GetNamespace("MAPI")
| Set objFolder = objNameSpace.PickFolder
| Me.RecordSource = "mail"
|
| For Each mail In objFolder.Items
| strFrom = mail.SenderName
| strTo = mail.To
| strCc = mail.Cc
| strSubject = mail.Subject
| For Each attachs In mail.Attachments
| strAttachment = strAttachment & attachs.DisplayName & vbCrLf
| Next attachs
| rsMail.Fields("To") = strTo
| strAttachment = ""
| rsMail.MoveNext
| rsMail.AddNew
| Next mail
| End Sub
|
| il me manque un petit qqc, si quelqu'un pouvait m'aider.
| Merci