Bonjour!
J'aimerais transfèrer un document Outlook dans Excel2000 J'ai la macro
suivante qui fonctionne en Excel 2003(mais au bureau on a la version 2000):
Sub GetFromInbox()
Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim i As Integer
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
i = 1
For Each olMail In Fldr.Items
' If InStr(olMail.Body, "lemaire") > 0 Or
'If InStr(olMail.Received.Name, "lemaire") > 0 Then
'ActiveSheet.Cells(i, 1).Value = olMail.Date
ActiveSheet.Cells(i, 2).Value = olMail.SenderName
ActiveSheet.Cells(i, 3).Value = olMail.Subject
ActiveSheet.Cells(i, 4).Value = olMail.Body
i = i + 1
' End If
Next olMail
Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
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
DoMi
Bonjour,
Inspiré d'une réponse de Michel Pierron du 16/11/2004:
Sub Reception()
Dim objOL(1 To 4) As Object Dim i As Integer
i = 1 Set objOL(1) = CreateObject("Outlook.Application") ' application Outlook Set objOL(2) = objOL(1).GetNamespace("MAPI") ' Crée l'espace de travail Outlook Set objOL(3) = objOL(2).GetDefaultFolder(6) ' Ouvre le dossier "Boite de réception"
For Each objOL(4) In objOL(3).Items ActiveSheet.Cells(i, 2).Value = objOL(4).SenderName ActiveSheet.Cells(i, 3).Value = objOL(4).Subject ActiveSheet.Cells(i, 4).Value = objOL(4).Body i = i + 1 Next For i = LBound(objOL) To UBound(objOL) Set objOL(i) = Nothing Next i
End Sub
Bonjour! J'aimerais transfèrer un document Outlook dans Excel2000 J'ai la macro suivante qui fonctionne en Excel 2003(mais au bureau on a la version 2000 ): Sub GetFromInbox()
Dim olApp As Outlook.Application Dim olNs As NameSpace Dim Fldr As MAPIFolder
Dim olMail As Variant Dim i As Integer
Set olApp = New Outlook.Application Set olNs = olApp.GetNamespace("MAPI") Set Fldr = olNs.GetDefaultFolder(olFolderInbox) i = 1
For Each olMail In Fldr.Items ' If InStr(olMail.Body, "lemaire") > 0 Or 'If InStr(olMail.Received.Name, "lemaire") > 0 Then
'ActiveSheet.Cells(i, 1).Value = olMail.Date ActiveSheet.Cells(i, 2).Value = olMail.SenderName ActiveSheet.Cells(i, 3).Value = olMail.Subject ActiveSheet.Cells(i, 4).Value = olMail.Body i = i + 1 ' End If Next olMail
Set Fldr = Nothing Set olNs = Nothing Set olApp = Nothing
End Sub
Merci! Benoit:)
Bonjour,
Inspiré d'une réponse de Michel Pierron du 16/11/2004:
Sub Reception()
Dim objOL(1 To 4) As Object
Dim i As Integer
i = 1
Set objOL(1) = CreateObject("Outlook.Application") ' application
Outlook
Set objOL(2) = objOL(1).GetNamespace("MAPI") ' Crée
l'espace de travail Outlook
Set objOL(3) = objOL(2).GetDefaultFolder(6) ' Ouvre le
dossier "Boite de réception"
For Each objOL(4) In objOL(3).Items
ActiveSheet.Cells(i, 2).Value = objOL(4).SenderName
ActiveSheet.Cells(i, 3).Value = objOL(4).Subject
ActiveSheet.Cells(i, 4).Value = objOL(4).Body
i = i + 1
Next
For i = LBound(objOL) To UBound(objOL)
Set objOL(i) = Nothing
Next i
End Sub
Bonjour!
J'aimerais transfèrer un document Outlook dans Excel2000 J'ai la macro
suivante qui fonctionne en Excel 2003(mais au bureau on a la version 2000 ):
Sub GetFromInbox()
Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim i As Integer
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
i = 1
For Each olMail In Fldr.Items
' If InStr(olMail.Body, "lemaire") > 0 Or
'If InStr(olMail.Received.Name, "lemaire") > 0 Then
'ActiveSheet.Cells(i, 1).Value = olMail.Date
ActiveSheet.Cells(i, 2).Value = olMail.SenderName
ActiveSheet.Cells(i, 3).Value = olMail.Subject
ActiveSheet.Cells(i, 4).Value = olMail.Body
i = i + 1
' End If
Next olMail
Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
Inspiré d'une réponse de Michel Pierron du 16/11/2004:
Sub Reception()
Dim objOL(1 To 4) As Object Dim i As Integer
i = 1 Set objOL(1) = CreateObject("Outlook.Application") ' application Outlook Set objOL(2) = objOL(1).GetNamespace("MAPI") ' Crée l'espace de travail Outlook Set objOL(3) = objOL(2).GetDefaultFolder(6) ' Ouvre le dossier "Boite de réception"
For Each objOL(4) In objOL(3).Items ActiveSheet.Cells(i, 2).Value = objOL(4).SenderName ActiveSheet.Cells(i, 3).Value = objOL(4).Subject ActiveSheet.Cells(i, 4).Value = objOL(4).Body i = i + 1 Next For i = LBound(objOL) To UBound(objOL) Set objOL(i) = Nothing Next i
End Sub
Bonjour! J'aimerais transfèrer un document Outlook dans Excel2000 J'ai la macro suivante qui fonctionne en Excel 2003(mais au bureau on a la version 2000 ): Sub GetFromInbox()
Dim olApp As Outlook.Application Dim olNs As NameSpace Dim Fldr As MAPIFolder
Dim olMail As Variant Dim i As Integer
Set olApp = New Outlook.Application Set olNs = olApp.GetNamespace("MAPI") Set Fldr = olNs.GetDefaultFolder(olFolderInbox) i = 1
For Each olMail In Fldr.Items ' If InStr(olMail.Body, "lemaire") > 0 Or 'If InStr(olMail.Received.Name, "lemaire") > 0 Then
'ActiveSheet.Cells(i, 1).Value = olMail.Date ActiveSheet.Cells(i, 2).Value = olMail.SenderName ActiveSheet.Cells(i, 3).Value = olMail.Subject ActiveSheet.Cells(i, 4).Value = olMail.Body i = i + 1 ' End If Next olMail
Set Fldr = Nothing Set olNs = Nothing Set olApp = Nothing
