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
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
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.
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
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.
Archon <mbourbeau@archonsoft.com> 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
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.
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