OUTLOOK:deplacement message+ouverture excel

[jacques]

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set mynewfolder = myFolder.Folders("Demande de Réservation")
'cherche le premier message dont l'objet sois FORM Result

Set myitem = mynewfolder.Items.Find("[Subject] =""FORM Results""")

Jusque là ça va, mais comment:
- déplacer myitem (qui est dans la boite "FORM Rseults" dans une autre boite : "demande taitées"??) la fonction "MOVE" ne marche pas

par ailleurs, comment ouvrir automatiquement un fichier Excel lorsqu'un message arrive dans la boite "FORM Results"?

qq'un a-t-il une idée?

 

[Moa]

Salut Jacques !

Tu sais, si tu ne dis pas les mots magiques, je pense que personne ne te répondra.

Tiens approche ton oreille..allez encore plus près...allez....fait un effort...:

"Bonjour, S'il vous plaît, Merci "

Voilà, cela devrait te mettre dans le bon chemin.

@ +

Moa

 

[jacques]

cher Moa....
Tu as mille fois raison!
j'ai planché sur mon pb depuis qq jours et puis j'ai décidé de chercher de l'aide et comme d'habitude il manque souvent des précisions sur ce que l'on veut faire, j'ai trouvé plus pratique de copier directement là où j'en etais...en oubliant le principal: la politesse...
ta remarque est d'autant plus juste qu'elle est empreinte des respect...ce que ma demande n'avait pas!
merci de me remettre à ma place...
Très sincèrement
Jacques
(je refais une demande..."normale")

 

[Jon]

Sub dd()
Dim olApp As New Outlook.Application
Dim olNmSp As Outlook.NameSpace
Dim sf As Outlook.MAPIFolder
Dim olTgtFolder As Outlook.MAPIFolder
Dim xy As Outlook.MailItem


Set olNmSp = olApp.GetNamespace("MAPI")
Set olDefltFolder = olNmSp.GetDefaultFolder(olFolderInbox)
Set olTgtFolder = olDefltFolder.Folders("test")

Set xy = olDefltFolder.Items.Find("[Subject]=""Golf w/ Jerry Wheeler""")


If Not xy Is Nothing Then
MsgBox xy.Body & "déplacé"
xy.Move olTgtFolder
End If

End Sub

 

[jacques]

Encore mille merci pour cette aide, Jon!
J'ai pu faire ce que je voulais.Il n'y a pas baucoup de personne qui trvaillent Excel et outlook, cela est d'autant plus précieux, merci encore.

Puisque tu connais un peu le sujet:
- sais tu comment marquer "lu" ou "Non Lu" un message? la recherche dans l'aide de "read", "message" ne m'a pas permis de trouver la réponse.

- d'autre part, sais tu s'il est possible que ma bécane, (de la m^me façon que la planificateur de ta^ches,ou l'alerte à l'arrivée d'un nouveau message pour Outlook,) déclenche l'ouverture d'un fichier excel quand arrive un nouveau message contenant le sujet "x" (qui, bien sûr, tu l'a deviné, va traiter les données du nouveau message!)?

 

[Jon]

voilà un code que j'avais pondu

la macro ListAllItemsInInbox génère une liste des messages de la boîte par défaut (inbox)

si tu lis un message non lu en appuyant sur le bouton correspondant, cela devrait le marquer comme lu

tu aurais pu retrouver ce code dans les archives du groupe microsoft.public.fr.excel et peut être dans celles de ce forum

'De :STéphane (stephoasis@free.fr)
'Objet: Re: Outlook express & VBA & Excel
'View: Complete Thread (10 articles)
'Groupes de discussion :microsoft.public.fr.excel
'Date :2001-09-06 06:33:48 PST


'Rebonjour


'j 'ai déjà pu me repencher sur mon code pour outlook et je l'ai perfectionné,
'dans la mesure om j'ai pu manipulé les attachements des mails. Une référence
'à la bibliothèque d'objets d'outlook est nécessaire.

'lancer le code et si vous avez des mails dans outlook (tout court), vous
'verrez ce que cela donne sous excel (choisissez une feuille vierge)

'lorsque vous choisissez l'annexe dans la liste déroulante, cette annexe est
'sauvegardée dans le répertoire "c:\mes docs\", variable temp ; il manque
'juste l 'ouverture de celle-ci, que je recommande d'effectuer avec la méthode
'shell ou hyperlink pour laisser au système trouver quelle est l'application
'qui doit prendre en charge cette ouverture.
'
'manque les finitions, comme le visu du message (soit afficher le mail, soit
'afficher le cntenu du message dans une boîte texte ou autre chose, mais le
'hic c 'est les mails au format HTML)
'
'manque aussi la possibilité de choisir un répertoire donné ou de boucler sur
'tous
'
'un truc à vérifier aussi, je boucle sur les items, mais un item peut aussi
'être autre chose qu'un fichier ?
'
'
'bonne journée
'Stéphane


Sub ListAllItemsInInbox()
Dim OLF As Outlook.MAPIFolder, CurrUSer As String
Dim EmailItemCount As Integer, i As Integer, emailcount As Integer
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False:
'On Error Resume Next


'Sheets("Courrier").Select
ActiveSheet.Select
Cells.Delete: ActiveSheet.Buttons.Delete: ActiveSheet.DropDowns.Delete
Cells.RowHeight = 21.5: Columns(7).ColumnWidth = 20

Range("A1:G1").Font.Bold = True: Range("A1:G1").Font.Size = 12
Cells(1, 1).Formula = "De"
Cells(1, 2).Formula = "Sujet"
Cells(1, 3).Formula = "Date"
Cells(1, 4).Formula = "Annexes"
Cells(1, 5).Formula = "Lu ?"
Cells(1, 7).Formula = "Ouvrir les annexes"

'Selection.AutoFormat Format:=xlRangeAutoFormatClassic2, Number:=True, _
Font:=True, Alignment:=True, Border:=True, Pattern:=True, Width:=True

Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

EmailItemCount = OLF.Items.Count
i = 0: emailcount = 0
' read e-mail information
While i < EmailItemCount
i = i + 1
If i Mod 50 = 0 Then Application.StatusBar = "Reading e-mail messages " & Format(i / EmailItemCount, "0%") & "..."
With OLF.Items(i)
emailcount = emailcount + 1
Cells(emailcount + 1, 2).Formula = .Subject
Cells(emailcount + 1, 1).Formula = .SenderName
Cells(emailcount + 1, 3).Formula = Format(.ReceivedTime, "dd.mm.yyyy hh:mm")
Cells(emailcount + 1, 4).Formula = .Attachments.Count
Cells(emailcount + 1, 5).Formula = Not .UnRead


'créer un bouton
Cells(emailcount + 1, 5).Select
ActiveSheet.Buttons.Add(1, 1, Selection.Width, Selection.Height).Select
Selection.Name = "Btn" & (emailcount + 1)
ActiveSheet.Buttons("Btn" & (emailcount + 1)).Top = Cells(emailcount + 1, 6).Top
ActiveSheet.Buttons("Btn" & (emailcount + 1)).Left = Cells(emailcount + 1, 6).Left
Selection.OnAction = "lire_fichier"

Cells(emailcount + 1, 7).Select
ActiveSheet.DropDowns.Add(1, 1, Selection.Width, Selection.Height).Select
Selection.Name = "DropD" & (emailcount + 1)
Selection.LinkedCell = ActiveSheet.Range("G" & emailcount + 1).Address
ActiveSheet.DropDowns("DropD" & (emailcount + 1)).Top = Cells(emailcount + 1, 7).Top
ActiveSheet.DropDowns("DropD" & (emailcount + 1)).Left = Cells(emailcount + 1, 7).Left
Selection.OnAction = "go_fichier"
End With

If OLF.Items(i).Attachments.Count <> "" Then
For j = 1 To OLF.Items(i).Attachments.Count
nomfichier = OLF.Items(i).Attachments.Item(j)
ActiveSheet.DropDowns("DropD" & (emailcount + 1)).AddItem nomfichier

Next j
End If

Wend
Application.Calculation = xlCalculationAutomatic
Range("G2") = OLF.UnReadItemCount


Set OLF = Nothing
Columns("A:E").AutoFit
Range("A2").Select
ActiveWindow.FreezePanes = True
' ActiveWorkbook.Saved = True
Application.StatusBar = False
End Sub


Sub go_fichier()

Dim OLF As Outlook.MAPIFolder: tempPath = "C:\Mes Docs\"
Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

nomDropDown = Mid(Application.Caller, 6)
MsgBox OLF.Items(nomDropDown - 1).Attachments(Range("G" & (nomDropDown)).Value)
Set fich_attache = OLF.Items(nomDropDown - 1).Attachments(Range("G" & (nomDropDown)).Value)

OLF.Items(nomDropDown - 1).Attachments(Range("G" & (nomDropDown)).Value).SaveAsFile tempPath & _
OLF.Items(nomDropDown - 1).Attachments(Range("G" & (nomDropDown)).Value).DisplayName
Range("G" & nomDropDown) = 0

End Sub


Sub lire_fichier()
Dim OLF As Outlook.MAPIFolder, olMailItem As Outlook.MailItem, ToContact As Recipient
Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set olMailItem = OLF.Items.Add ' creates a new e-mail message
Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
' innboksen

nomBouton = Mid(Application.Caller, 4)
Range(Cells(nomBouton, 1), Cells(nomBouton, 5)).Select
MsgBox OLF.Items(nomBouton - 1).Body
OLF.Items(nomBouton - 1).UnRead = False: OLF.Items(nomBouton - 1).Save
Range("A1").Select
End Sub


Sub checker_courrier()
Dim OLF As Outlook.MAPIFolder
Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

MsgBox OLF.UnReadItemCount
End Sub


'
'
'exemple d 'analyse de contenu d'un mail, mais de manière très bâtarde, que
'j 'avais mise en place pour analyser des messages envoyés par mon serveur


Sub citeweb()
Dim corps As DataObject
Dim c, i, ipv, iph, ipn
Set corps = New DataObject
Dim OLF As Outlook.MAPIFolder, CurrUSer As String, myOlApp As Object, EmailItemCount As Integer, emailcount As Integer
On Error Resume Next
Set myOlApp = CreateObject("Outlook.Application") 'créer une fenêtre outlook
'Set myfolder = olNameSpace.Folders(1).Folder(2).Name
Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
' innboksen
EmailItemCount = OLF.Items.Count
emailcount = 0
i = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Cells.Clear: ActiveSheet.Buttons.Delete: ActiveSheet.DropDowns.Delete
Cells.RowHeight = 21.5: Columns(8).ColumnWidth = 20
Cells(1, 1).Formula = "Adresse IP du visiteur"
Cells(1, 2).Formula = "Hôte du visiteur"
Cells(1, 3).Formula = "Navigateur"
Cells(1, 4).Formula = "Date"
Cells(1, 5).Formula = "Heure"

With Range("A1:E1").Font
.Bold = True
.Size = 14
End With

While i < EmailItemCount
i = i + 1
If i Mod 50 = 0 Then Application.StatusBar = "Reading e-mail messages " & Format(i / EmailItemCount, "0%") & "..."

If OLF.Items(i).Subject = "CITEWEB - ERREUR 404" Then
emailcount = emailcount + 1
Cells(emailcount + 1, 4).Formula = Format(OLF.Items(i).ReceivedTime, "dd.mm.yyyy")
Cells(emailcount + 1, 5).Formula = Format(OLF.Items(i).ReceivedTime, "hh:mm")
corpstexte = OLF.Items(i).Body
corps.SetText corpstexte
corps.putinclipboard
Range("G1").Select: ActiveSheet.Paste

Columns("G:G").Select
Selection.Find(What:="adresse ip du visiteur : ", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Activate
ipv = Mid(ActiveCell.Value, 25, ActiveCell.Characters.Count)

Range("A1").Select: Columns("G:G").Select
c = Cells.Find(What:="hôte", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True).Activate
If c = True Then iph = Mid(ActiveCell.Value, 25, ActiveCell.Characters.Count)
If ActiveCell.Value = "CECI EST UN MAIL AUTOMATIQUE. IL NE FAUT PAS Y REPONDRE !" Then iph = ""

Columns("G:G").Select
Selection.Find(What:="navigateur : ", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Activate
ipn = Mid(ActiveCell.Value, 25, ActiveCell.Characters.Count)

Range("A" & emailcount + 1) = ipv
Range("B" & emailcount + 1) = iph
Range("C" & emailcount + 1) = ipn

Else
End If

Wend
Columns("G:G").ClearContents: Columns("A:B").AutoFit: Range("A1").Select
[f1] = emailcount
Application.StatusBar = ""
End Sub


Sub dd()
Dim olApp As New Outlook.Application
Dim olNmSp As Outlook.NameSpace
Dim sf As Outlook.MAPIFolder
Dim olTgtFolder As Outlook.MAPIFolder
Dim xy As Outlook.MailItem


Set olNmSp = olApp.GetNamespace("MAPI")
Set olDefltFolder = olNmSp.GetDefaultFolder(olFolderInbox)
Set olTgtFolder = olDefltFolder.Folders("test")

Set xy = olDefltFolder.Items.Find("[Subject]=""Golf w/ Jerry Wheeler""")
xy.UnRead
If Not xy Is Nothing Then
MsgBox xy.Body & "déplacé"
xy.Move olTgtFolder
End If

End Sub