Vba outlouk 2007 (sauvegarde auto des msg sur DD)

mikelee75 - 28 mai 2013 à 13:07
 mikelee75 - 28 mai 2013 à 21:42
Bonjour à tous,

J'ai besoin d'aide pour une tache répétitive à mon travail.

J'aimerais donc pouvoir enregistrer automatiquement les messages envoyés (senti item) sur outlook sur un dossier de mon disque dur.
Puis si c'est possible déplacer le message envoyé dans outlook directement dans un dossier (qui est crée tout les matin à la date du jour)


Je vous remercie pour l'attention que vous porterez à ce message

Cdt,

2 réponses

Utilisateur anonyme
28 mai 2013 à 20:29
Le règlement joualvert; le règlement.
0
Hello again,
je complète mon message précédant (en espérant respecter le règlement)

j'ai voulu reprendre ce code pour enregistrer au format .msg après envoi sur un disque physique:
Private Sub Application_Startup() 
'pour evenement itemadd    
Dim NS As Outlook.NameSpace    
Set NS = Application.GetNamespace("MAPI")    
Set colSentItems = NS.GetDefaultFolder(olFolderSentMail).Items    
Set NS = Nothing  'fin section 
end sub 

Private Sub colSentItems_ItemAdd(ByVal Item As Object) 
'By Oliv ' janv 2008 pour Outlook 2003 feat. Sue Mosher 
'http://www.outlookcode.com/codedetail.aspx?id=456     
If Item.Class = olMail Then         
Repertoire = "C:"         
Strname = Repertoire & "Email " & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Item.Subject, "", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 160)         
Enrg = MsgBox(Item.Subject & vbCr & "sous : " & vbCr & Strname & ".msg", vbYesNoCancel, "Enregistrer sur le disque ce mail ?")
         If Enrg = vbYes Then
             ' 1ère façon sans boite de dialogue on connait l'endroit où enregistrer
             'Repertoire = BrowseForFolder("Choisissez la destination", SDossier(5, 0)) & ""
             Item.SaveAs Strname & ".msg", OlSaveAsType.olMSG
          ElseIf Enrg = vbNo Then
         ' 2ème méthode on ouvre une boite de dialogue
          Item.Display
          Dim objInsp
          Dim colCB
          Dim objCBB
          On Error Resume Next
          Set objInsp = item.GetInspector
          Set colCB = objInsp.CommandBars
          Set objCBB = colCB.FindControl(, 748) 'enregistrer  sous
          If Not objCBB Is Nothing Then
              objCBB.Execute
          End If
          Item.Close olDiscard
         End If
     End If
 End Sub    

mais rien ne se passe, je ne comprend pas vraiment quoi faire.

merci
0
Rejoignez-nous