probleme outlook 2007

Question

slt out le monde j ai un problème avec outlook 2007 (je suis sur xp) j ai copier un code en vba dans Outlook pour enregistrer les pièce jointe automatique sans aucune intervention Sub extrait_PJ_vers_rep(strID As Outlook.MailItem) ' ***moez ben mansour*** ' 28/09/2010 Dim olNS As Outlook.NameSpace Dim MyMail As Outlook.MailItem Dim expediteur Set olNS = Application.GetNamespace("MAPI") Set MyMail = olNS.GetItemFromID(strID.EntryID) If MyMail.Attachments.Count > 0 Then expediteur = MyMail.SenderEmailAddress Repertoire = "c:\x" If Repertoire <> "" Then If "" = Dir(Repertoire, vbDirectory) Then MkDir Repertoire End If End If 'on traite les pj Dim PJ, typeatt For Each PJ In MyMail.Attachments typeatt = Isembedded(strID, PJ.Index) If typeatt = "" Then If "" <> Dir(Repertoire & PJ.FileName, vbNormal) Then 'si existe copie vers le répertoire old If "" = Dir(Repertoire & "ancien commande promod", vbDirectory) Then MkDir Repertoire & "ancien commande promod" End If FileCopy Repertoire & PJ.FileName, Repertoire & "ancien commande promod" & PJ.FileName End If PJ.SaveAsFile Repertoire & PJ.FileName End If Next PJ MyMail.FlagIcon = olGreenFlagIcon MyMail.UnRead = False MyMail.Save End If Set MyMail = Nothing Set olNS = Nothing Fin: End Sub Function Isembedded(ByVal strEntryID As String, attindex As Integer) As Variant Dim oSession As MAPI.Session ' CDO objects Dim oMsg As MAPI.Message Dim oAttachs As MAPI.Attachments Dim oAttach As MAPI.Attachment On Error Resume Next Set oSession = CreateObject("MAPI.Session") oSession.Logon "", "", False, False Set oMsg = oSession.GetMessage(strEntryID) Set oAttachs = oMsg.Attachments Set oAttach = oAttachs.Item(attindex) Dim strCID As String strCID = oAttach.Fields(&H3712001E) Isembedded = strCID Set oMsg = Nothing oSession.Logoff Set oSession = Nothing End Function tous sa passe bien les pj s enregistre dans c:\x mais si je modifier ce répertoire avec un autre sur le réseau par exemple \serveur\x une erreur se déclenche erreur 52 nom et num de fichier incorrecte et le problème sur ce ligne: If "" = Dir(Repertoire, vbDirectory) Then ce problème de déclenche que si je met un chemin sur le réseau (hors de mon disq) et je men suis sur que le chemin du réseau et correcte et sa passe pas.

Renfield · Answer

Repertoire = "c:\x" 
If Repertoire <> "" Then 

pour un test inutile ...

Dir ne fonctionne pas avec les repertoires reseau.

utiliser par exemple DoesExist


Renfield - Admin CodeS-SourceS - MVP Visual Basic	& Spécialiste des RegExp

Renfield · Answer

Code typiquement issu de divers copier/coller, mal maitrisés et non analysé...

extrait_PJ_vers_rep recoit  en parametre un MailItem...

pas besoin d'en récupérer un autre, si ?

Renfield - Admin CodeS-SourceS - MVP Visual Basic	& Spécialiste des RegExp

Renfield · Answer

j'ai pas 2007, a corriger, donc (J'ai aucune trace de Fields, pour le test IsEmbedded), mais : Option Explicit Public Declare Function MkDir Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal DirPath As String) As Long Public Declare Function GetFileAttributes Lib "kernel32.dll" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long Public Const INVALID_FILE_ATTRIBUTES As Long = &HFFFFFFFF Public Function DoesExist(ByRef vsPath As String) As Boolean DoesExist = (GetFileAttributes(vsPath) <> INVALID_FILE_ATTRIBUTES) End Function Public Function extrait_PJ_vers_rep(ByVal Folder As String, ByRef Mail As Outlook.MailItem) As Long Dim Attachment As Attachment Dim IsEmbedded As Boolean If Not Nothing Is Mail Then If Mail.Attachments.Count > 0 Then If Right$(Folder, 1) <> "" Then Folder = Folder & "" End If For Each Attachment In Mail.Attachments IsEmbedded = True On Local Error Resume Next '# Semble etre propre à Outlook 2007 et supérieur IsEmbedded = Attachment.Fields(&H3712001E) On Local Error GoTo 0 If IsEmbedded Then If DoesExist(Folder & Attachment.FileName) Then MkDir Folder & "ancien commande promod" FileCopy Folder & Attachment.FileName, Folder & "ancien commande promod" & Attachment.FileName Else MkDir Folder End If Attachment.SaveAsFile Folder & Attachment.FileName extrait_PJ_vers_rep = extrait_PJ_vers_rep + 1 End If Next '# Semble etre propre à Outlook 2007 et supérieur 'Mail.FlagIcon = olGreenFlagIcon Mail.UnRead = False Mail.Save End If DoEvents End If End Function Sub test() Dim Item As Object Dim nAttachments As Long Dim nCount As Long Dim nMails As Long Dim nMailsWithAttachments As Long For Each Item In Session.GetDefaultFolder(olFolderInbox).Items If TypeOf Item Is MailItem Then nMails = nMails + 1 nCount = extrait_PJ_vers_rep("C:\x", Item) If nCount Then nMailsWithAttachments = nMailsWithAttachments + 1 nAttachments = nAttachments + nCount End If End If Next MsgBox nMails & " mails lus." & vbNewLine & _ nAttachments & " pièces jointes archivées, réparties dans " & nMailsWithAttachments & " mails.", vbInformation End Sub Renfield - Admin CodeS-SourceS - MVP Visual Basic & Spécialiste des RegExp

bizerte110 · Answer

je vous merci pour votre solution 
mais malheureusement la fonction DoesExit()engendre aussi des erreur
peut tu svp modifier les ligne de mon code (puisque mon code et lier avec des règles) pour que les pj s enregistre dans le répertoire  \serveur\x
et je vous remercie bien 
aussi y a t'il une solution d extraire des pj d un mail et l'envoie automatiquement a son destinataire exp
un message qui comporte x.txt et y.txt y a t'il une possibilité d extraire juste y.txt et l'envoie automatiquement a sa destinataire (code vba par exemple avec règle)
et merci d avance.

Renfield · Answer

DoesExist, des erreurs ?  
lesquelles ???? 
J'ai fait le test en appelant:

nCount = extrait_PJ_vers_rep("\prsousieg01\Isis\PJ", Item)

pas eu de souci...


il est fort aisé de faire une macro qui s'execute a la reception d'un e-Mail... voir "assistant Gestion des messages" dans Outlook.

quant à n'exporter que telle ou telle piece jointe, c'est assez simple a mettre en place en testant le Attachment.FileName


Renfield - Admin CodeS-SourceS - MVP Visual Basic	& Spécialiste des RegExp

bizerte110 · Answer

slt renfield
je vous remerci encore 
 mon code est intègres dans un module et il s exécute a travers une règle sur Outlook pour cela je veut svp rectifier la ou les ligne pour qui il permet d enregistrer le pièce jointe voici le code Sub extrait_PJ_vers_rep(strID As Outlook.MailItem)

  

 

    Dim olNS As Outlook.NameSpace
    Dim MyMail As Outlook.MailItem

    Dim expediteur
    Set olNS = Application.GetNamespace("MAPI")
    Set MyMail = olNS.GetItemFromID(strID.EntryID)
    

    If MyMail.Attachments.Count > 0 Then

        expediteur = MyMail.SenderEmailAddress


        Repertoire = "E:\x"
        If Repertoire <> "" Then

            If "" = Dir(Repertoire, vbDirectory) Then

                MkDir Repertoire

            End If

        End If

        'on traite les pj

        Dim PJ, typeatt

        For Each PJ In MyMail.Attachments
            
            typeatt = Isembedded(strID, PJ.Index)

            If typeatt = "" Then


                PJ.SaveAsFile Repertoire & PJ.FileName

            End If

        Next PJ

         

        MyMail.FlagIcon = olGreenFlagIcon

        

        MyMail.UnRead = False

        MyMail.Save

    End If

    Set MyMail = Nothing
    Set olNS = Nothing

Fin:

End Sub



 
Function Isembedded(ByVal strEntryID As String, attindex As Integer) As Variant

    Dim oSession As MAPI.Session
    ' CDO objects

    Dim oMsg As MAPI.Message
    Dim oAttachs As MAPI.Attachments

    Dim oAttach As MAPI.Attachment

    

    On Error Resume Next

    Set oSession = CreateObject("MAPI.Session")
    oSession.Logon "", "", False, False

     
 
    Set oMsg = oSession.GetMessage(strEntryID)
     
    Set oAttachs = oMsg.Attachments
    Set oAttach = oAttachs.Item(attindex)
    Dim strCID As String

    strCID = oAttach.Fields(&H3712001E)

    Isembedded = strCID

    Set oMsg = Nothing

    oSession.Logoff

    Set oSession = Nothing

End Function

sur ce code ou je peut faire le mise a jour sur ce code et merci d avance

Renfield · Answer

Remplaces dans mon code :
Public Function extrait_PJ_vers_rep(ByVal Folder As String, ByRef Mail As Outlook.MailItem) As Long


par 

Public Function extrait_PJ_vers_rep(ByRef Mail As Outlook.MailItem) 
As Long
Dim Folder As String : Folder = "E:\x"

Merci d'utiliser la barre d'outils de la boite de texte du forum pour colorier le code, a l'avenir...


Renfield - Admin CodeS-SourceS - MVP Visual Basic	& Spécialiste des RegExp

bizerte110 · Answer

merci encore une Foix
 j ai modifier votre code et il marche très bien mais lorsque  je veut le sélectionner comme un  script dans une règle "exécuter un script" la petite dialogue n affiche rien.
ce code doit  s' exécuter que lorsque je reçois un message avec un nom d objet bien définie exemple "commande" donc il faut l' intégré "code" dans une règle le seul moyen c est l'exécuter comme un script dans Outlook 2007
s il y'a une autre méthode je vous remercie "en prenant compte juste des messages qui comprennent "commande "comme objet et pas les autres messages.
et svp je suis un débutant si vous voulez s il ya une solution avec précision
merci infiniment

Probleme outlook 2007

8 réponses

Votre réponse

Discussions similaires