vba outlook / word [Résolu]

[dirtsa]

Bonjour,
je suis en train de créer une newsletter automatique et pour cela, je dois récupérer les informations pour la newsletter dans différents e-mails via leurs pièces jointes.
Tout en VBA, j'ai commencé par classer les mails correspondants aux critères dans un dossier "à traiter", et là, j'ai une boucle pour traiter chacune des pièces jointes présentes dans ce dossier.
et là, je suis complètement bloquée

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Sub concaten()
 
    Dim uneAppli As New Outlook.Application
    Dim docWord As Object
    Dim myName As String
    Dim i As Integer
    Dim NbMail As Long
    Dim Mynamespace As Outlook.NameSpace
 
    Set Mynamespace = uneAppli.GetNamespace("MAPI")
    Set uneAppli.ActiveExplorer.CurrentFolder = Mynamespace.GetDefaultFolder(olFolderInbox)
    NbMail = Mynamespace.Folders.GetFirst.Folders.GetNext.Folders.GetNext.Items.Count
    If NbMail >= 1 Then
        Set docWord = Application.CreateObject("Word.Application")
        docWord.Visible = True
        For i = 1 To NbMail
        'Call word(pj)
        Call deplacer_fin
        ...
    End If
End Sub

J'avoue que le code n'est pas super, surtout pour obtenir le nombre de message dans le dossier mais ce n'est pas le plus important pour l'instant.
bon, j'ai pas tout mis... et "call word(pj)" c'est pour dire que c'est là que je mettrai la procédure avec la pj en paramètre. Mais je ne sais pas du tout comment faire pour que Word récupère la pièce jointe !

Quelqu'un aurai une idée pour la marche à suivre ? ça devient assez urgent !

[asteroide26]

J'ai le même problème, je ne sais pas si c'est plus simple mais j'ai pensé à un moyen pour détourner le problème :
ce serait d'ouvrir la pièce jointe, utiliser la fonction "wait" d'outlook et passer la main à Word, mais à l'heure actuelle, je n'y suis toujours pas parvenue.
Je débute en vba et là, je ne sais pas comment faire !

[Heureux-oli]

C'est la logique qui n'y est pas.

Pour récupérer les pièces jointes par Word, il faut les ouvrir dans le répertoire contenant les pièces jointes.

[asteroide26]

J'ai suivit ton conseil :
j'ai recherché le répertoire dans lequel il y a les e-mail avec les pièces jointes
ça, c'est bon, maintenant, j'aimerai ouvrir la pièce jointe. Pour cela, j'ai déclaré

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub ouvrir_pj()
    Dim appli As Outlook.application
    Dim dossier As Outlook.Folder
    Dim myItem As Outlook.MailItem
    Dim pj As Outlook.Attachments
    Dim myNamespace As Namespace
 
    Set appli = New Outlook.application
    Set myNamespace = Outlook.GetNamespace("MAPI")
    Set dossier = myNamespace.GetDefaultFolder(olFolderInbox).Folders.GetNext
    Debug.Print dossier
    Set myItem = dossier.Items.GetFirst
    Debug.Print myItem.Attachments.Item(1).Filename
    pj = myItem.Attachments.Item(i)
    ...
End Sub

j'arrive à lire le nom des pièces jointes, mais ce qui m'agace un peu, c'est que je ne trouve pas la méthode pour ouvrir la pièce jointe (sachant bien que c'est un document Word). Et là, ça bug à pj = myItem.Attachments.Item(1) j'ai essayer avec .Index et bien d'autre mais sans succes

PS : tous les debug.print c'est pour vérifier que je suis dans le bon sens

[Heureux-oli]

Tu dois sauver la pièce jointe dans un répertoire du disque dur et pas dans un répertoire outlook.

Pour récupérer les fichiers, jette un oeil ici

[asteroide26]

Bon, j'ai modifier mon code pour sauvegader les e-mail sur le disque dur en m'inspirant fortement du lien que tu m'as passé. Pour l'instant, j'en suis à la configuration du chemin et création du dossier si nécessaire.
si le dossier n'existe pas, alors le code le crée, mais il affiche un message d'erreur : "Erreur d'exécution '13' : imcompatibilité de type"

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Function creer_dossier_sauv(ByVal dossier As String)
 
    On Error GoTo err
    Dim oFSO As Scripting.FileSystemObject
    Dim oFld As Folder
 
    'Instanciation du FSO
    Set oFSO = New Scripting.FileSystemObject
    On Error GoTo err
    If oFSO.FolderExists(dossier) = False Then
        Set oFld = oFSO.CreateFolder(dossier)
    End If
 
fin:
    Exit Function
err:
    Select Case err.Number
       Case 13: Debug.Print "incompatibilité de type"
       Case 58: Debug.Print "Le dossier existe déjà"
       Case 76: Debug.Print "Chemin incorrect"
       Case Else: Debug.Print "Erreur inconnue"
    End Select
    Resume fin
 
End Function
 
Sub recherche_dossier()
 
    Dim oFSO As Scripting.FileSystemObject
    Dim oFld As Folder
    Dim dossier As String
 
    dossier = ""
    dossier = "D:\stage\2em_annee\"         'chemin du dossier d'enregistrement
    dossier = dossier & "newsletter_" & Format(Now, "dd.mm.yyyy")
 
Set oFSO = New Scripting.FileSystemObject
'Accède au dossier
If oFSO.FolderExists(dossier) = False Then
    Debug.Print "Ce dossier n'existe pas"
    Call creer_dossier_sauv(dossier)
End If
 
End Sub

Puisque le dossier est créé comment se fait il qu'il y ait ce message d'erreur et y a-t-il y moyen de le masquer ?

[asteroide26]

Je n'ai pas encore résolu le problème précedent mais il y a plus grave : même en m'inspirant du lien vers la manipulation des fichiers en vba, je n'arrive pas à enregistrer la pièce jointe !

Code :

1
2
3
4
5
6
7
8
9
10
11
Sub deplacer_fin(ByVal i As Integer)
    Dim myOlApp As New Outlook.Application
    Dim myItem As Outlook.MailItem
    Dim myNameSpace As Outlook.NameSpace
 
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set myItem = myNameSpace.Folders.GetFirst.Folders.GetNext.Folders.GetNext.Items.GetFirst
    Debug.Print myItem.Subject
 
    myItem.Attachments.SaveAsFile "D:\doc1.doc"
End Sub

pour la ligne "myItem.Attachments.SaveAsFile "D:\doc1.doc" " j'ai un message d'erreur "438" : propriété ou méthode non gérée par cet objet. Je ne vois pas où est l'erreur ! d'après l'aide d'outlook, c'est ainsi qu'on détermine le chemin et le nom du document qu'on veut enregistrer !
help !!
est-ce que ce serait myItem qui ne supporterait pas cet ordre ?

[asteroide26]

Bon, j'ai résoslu le problème de sauvegarde sur le disque dur. pour ceux que ça peut interresser :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
 
 Option Compare Binary
 Option Explicit
 
Public Sub envoi_sur_HD()
 
Dim objOutlook As Outlook.Application 'représente l'application outlook
Dim objItems As Outlook.Items 'représente un objet outlook
Dim objMailItem As MailItem 'représente un mail
Dim PJ As Attachment 'représente un fichier joint
Dim mailIndex As Integer 'représente le numéro d'indexation des mails
Dim cpt As Integer 'compteur de mails traités
Dim reponse 'affichage de msg
 
 
cpt = 0 'initialisation
 
Set objOutlook = New Outlook.Application 'objOutlook devient l'application
 
Set objItems = objOutlook.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
'objItems représente la boîte de reception
 
For mailIndex = 1 To objItems.Count 'pour index de mail allant de 1 au nb total de mail
 
Set objMailItem = objItems.item(mailIndex) 'objMailItem devient le mail indexé par mailIndex
 
If objMailItem.Subject Like "informations_Newsletter" Then
    'si le sujet du mail est "inform..." alors
 
     Set PJ = objMailItem.Attachments.item(1) 'PJ reçoit la 1ere pîèce jointe de ce mail et la seule mais objMailItem.Attachemennts est l'ensemble de ses pièces jointes, il faut donc préciser le numéro de celui qui nous interresse
     PJ.SaveAsFile "d:\sondage\" & PJ.DisplayName
     'On sauve la pièce jointe dans le dossier sondage le fichier s'appelle comme la pièce jointe
     objMailItem.Delete 'destuction du mail
     'qui entraine des changement dans l'indexation des mails
     Set objItems = objOutlook.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
     'on recommence l'indexation
 
     mailIndex = 0 'on remet l'index à 0 (cette instruction ne semble pas fonctionner ! ????
     cpt = cpt + 1 'et on incrémente le nombre de mail traité
   End If
 
  Select Case mailIndex 'ces instructions servent à résoudre le problème
  Case objItems.Count: Exit For 'de la réinitialisation de l'index (nécessaire après le delete !)
  End Select 'Si l'index est égale au nombre de mail, il faut sortir.
Next
 
End Sub

attention ! me message est supprimer de la boite de récéption par la ligne de code suivante :

Code :

objMailItem.Delete

je tiens à préciser que ce code n'est pas de moi.

[dirtsa]

Merci beaucoup Asteroide ! ton code m'a préciseuse ! quelques modifications pour moi et c'est parfait ! ça enregistre ! Merci beaucoup ! Je vais enfin pouvoir terminer mon developpement !
à tous !!