Probleme outlook 2007

Signaler
Messages postés
4
Date d'inscription
jeudi 28 décembre 2000
Statut
Membre
Dernière intervention
30 septembre 2010
-
Messages postés
4
Date d'inscription
jeudi 28 décembre 2000
Statut
Membre
Dernière intervention
30 septembre 2010
-
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.

8 réponses

Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
68
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
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
68
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
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
68
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
Messages postés
4
Date d'inscription
jeudi 28 décembre 2000
Statut
Membre
Dernière intervention
30 septembre 2010

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.
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
68
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
Messages postés
4
Date d'inscription
jeudi 28 décembre 2000
Statut
Membre
Dernière intervention
30 septembre 2010

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
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
68
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
Messages postés
4
Date d'inscription
jeudi 28 décembre 2000
Statut
Membre
Dernière intervention
30 septembre 2010

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