Enregistrer des pièces jointes automatiquement

**r.sandrine** · 29/01/2018, 10h14

J'ai fait plusieurs test de transfert de message, le problème viendrait du titre du message, à savoir RE: xxxx ou FW: xxx, pourtant le : fait bien partie de remplaceCaracteresInterdit

**Oliv-** · 29/01/2018, 10h27

Ajoutes avant la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

objAtt.SaveAsFile saveFolder & "\" & "[" & Format(itm.ReceivedTime, "ddmmyy-hhnn") & "]" & "_ " & remplaceCaracteresInterdit(objAtt.DisplayName)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
debug.print  saveFolder & "\" & "[" & Format(itm.ReceivedTime, "ddmmyy-hhnn") & "]" & "_ " & remplaceCaracteresInterdit(objAtt.DisplayName)
debug.print len(saveFolder & "\" & "[" & Format(itm.ReceivedTime, "ddmmyy-hhnn") & "]" & "_ " & remplaceCaracteresInterdit(objAtt.DisplayName))

et quand l'erreur arrive tu regardes en faisant debug, le contenu de la fenetre EXECUTION dans VBE

**r.sandrine** · 29/01/2018, 10h29

Bon je viens de faire des tests dans tous les sens avec un des emails qui plantent, apparemment c'est parce que il y a un espace à la fin de l'objet de l'email
Ca a l'air de marcher si dans le remplacecaracteresinterdits je dis de remplacer les caractères spéciaux par un _ et d'inclure l'espace

**Oliv-** · 29/01/2018, 10h34

Sinon pour supprimer les espaces devant et derrière c'est

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

savefolder=TRIM(savefolder)

**r.sandrine** · 29/01/2018, 10h42

Merci, ça semble bon avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Trim(remplaceCaracteresInterdit(itm.Subject))

**r.sandrine** · 29/01/2018, 11h28

Est ce qu'il est possible d'enregistrer le texte de l'email en pdf pour les emails qui ont une ou des pièces jointe, dans le même sous dossier que les pièces jointes ?

Merci encore

**Oliv-** · 29/01/2018, 12h38

C'est faisable,
soit via une "imprimante pdf",
soit en passant par le pilotage de WORD on enregistre le Mail au format olDoc

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
MSG_Name_Out= c:\temp\message
msg.SaveAs MSG_Name_Out, OlSaveAsType.olDoc

puis par AUTOMATION DE WORD on enregistre le doc en PDF

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

WdDoc.SaveAs2 MSG_Name_Out & ".pdf", wdFormatPDF

je t'ai mis que les instructions principales

**r.sandrine** · 29/01/2018, 16h24

Voilà où j'en suis, mais je ne sais pas comment déclarer l'automation de WORD

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Public Sub saveAttachtoDisk_exp_objet(itm As Outlook.MailItem)
'Cette macro créé un dossier par expéditeur et enregistre les pièces jointes
 
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim TypeAtt
 
saveFolder = "C:\temp\pj"
saveFolder = saveFolder & "\" & remplaceCaracteresInterdit(itm.SenderName) & "\" & "[" & Format(itm.ReceivedTime, "ddmmyy-hhnn") & "]" & Trim(remplaceCaracteresInterdit(itm.Subject))
 
 
For Each objAtt In itm.Attachments
 
TypeAtt = PJ_Isembedded(objAtt)
 
If TypeAtt = False Then
Call waaps_creedir(saveFolder)
objAtt.SaveAsFile Left(saveFolder & "\" & "[" & Format(itm.ReceivedTime, "ddmmyy-hhnn") & "]" & "_ " & Trim(remplaceCaracteresInterdit(objAtt.DisplayName)), 256)
itm.SaveAs saveFolder & "\" & itm.EntryID & ".doc", OlSaveAsType.olDoc
WdDoc.SaveAs2 saveFolder & "\" & itm.EntryID & ".pdf", wdFormatPDF
 
End If
 
Set objAtt = Nothing
 
Next
End Sub

Merci

**Oliv-** · 29/01/2018, 17h01

as tu cherché ?

https://word.developpez.com/faq/?pag...uveau_document
https://word.developpez.com/faq/?pag...excel_importer

**r.sandrine** · 30/01/2018, 09h25

Bonjour

J'avais cherché, j'ai encore regardé cherché et presque réussi, voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
48
49
50
51
52
53
54
 
 
Public Sub saveAttachtoDisk_exp_objet(itm As Outlook.MailItem)
'Cette macro créé un dossier par expéditeur et enregistre les pièces jointes
 
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim TypeAtt
 
 
saveFolder = "C:\temp\pj"
saveFolder = saveFolder & "\" & remplaceCaracteresInterdit(itm.SenderName) & "\" & "[" & Format(itm.ReceivedTime, "ddmmyy-hhnn") & "]" & Trim(remplaceCaracteresInterdit(itm.Subject))
 
Dim FSO As Object, TmpFolder As Object
Dim sName As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set tmpFilename = FSO.GetSpecialFolder(2)
 
For Each objAtt In itm.Attachments
 
TypeAtt = PJ_Isembedded(objAtt)
 
If TypeAtt = False Then
Call waaps_creedir(saveFolder)
objAtt.SaveAsFile Left(saveFolder & "\" & "[" & Format(itm.ReceivedTime, "ddmmyy-hhnn") & "]" & "_ " & Trim(remplaceCaracteresInterdit(objAtt.DisplayName)), 256)
 
 
tmpFilename = saveFolder & "\" & "email"
itm.SaveAs tmpFilename & ".doc", olDoc
 
 
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
 
Set wrdDoc = wrdApp.Documents.Open(FileName:=tmpFilename, Visible:=False)
 
wrdDoc.SaveAs2 tmpFilename & ".pdf", wdFormatPDF
 
Kill tmpFilename & ".doc"
 
wrdDoc.Close
wrdApp.Quit
Set wrdDoc = Nothing
Set wrdApp = Nothing
Set WshShell = Nothing
 
End If
 
Set objAtt = Nothing
 
 
Next
End Sub

Je bloque sur la suppression du fichier doc, j'ai "permission refusée" sur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Kill tmpFilename & ".doc"

Et est ce que il y a des choses à améliorer/ajouter/supprimer dans ce code ?

Merci

**r.sandrine** · 30/01/2018, 09h28

C'est bon je viens de trouver en fait

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
wrdDoc.SaveAs2 tmpFilename & ".pdf", wdFormatPDF
 
wrdDoc.Close
wrdApp.Quit
Set wrdDoc = Nothing
Set wrdApp = Nothing
Set WshShell = Nothing
 
Kill tmpFilename & ".doc"
 
End If

Donc il reste juste la dernière question, si il est possible d'améliorer ce code ?

Merci beaucoup

**Oliv-** · 30/01/2018, 09h43

Salut,

C'est pas mal du tout

j'ai pas compris à quoi te servait Set tmpFilename = FSO.GetSpecialFolder(2) puisque tu réaffectes la variable après

Tu peux ajouter des DoEvents après les instructions SaveAs et SaveAs2 et avant le kill

Ensuite une gestion d'erreur serait la bienvenue.

**r.sandrine** · 30/01/2018, 14h16

C'est bon j'ai retiré Set tmpFilename = FSO.GetSpecialFolder(2) et j'ai ajouté les Doevents.

Pour la gestion des erreurs, il faut que je regarde (je ne suis pas dans l'informatique, je me forme petit à petit ...)

Merci beaucoup

**r.sandrine** · 31/01/2018, 08h56

J'ai encore un petit bug, j'ai un contact pour qui les pièces jointes ne s'enregistrent pas. Je n'ai reçu que deux emails du même type de ce contact depuis la mise en place de la macro. Et ce n'est jamais enregistré.
Si je me transfère l'email les pièces jointes sont bien enregistrées donc ce n'est pas l'objet ni les pièces jointes qui sont en cause.
Le dossier de l'expéditeur ne se créé même pas et il n'y a pas de message d'erreur. Son nom est en 4 mots suivis de son email est ce que ça pourrait être lié ?
Sinon est ce que vous avez une idée d'où ça peut venir ?

Je voudrais tester manuellement la macro, comment pourrais je la transformer pour qu'elle ne se lance pas sur une règle mais sur la sélection de l'email ?

Merci

**Oliv-** · 31/01/2018, 09h45

Il faut utiliser le mode pas à pas en mettant un point d'arrêt
https://www.developpez.net/forums/bl.../debogage-vba/

pour lancer sur le mail OUVERT

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub test_script ()
    Dim StrID As Outlook.MailItem
    Set StrID = ActiveInspector.CurrentItem
    Call script(StrID)
End Sub

**r.sandrine** · 31/01/2018, 11h05

Je suis presque sûre que cet expéditeur n'est pas pris en compte à cause de son nom trop long.
Est ce que il existe un code pour extraire les 2 premiers mots de son nom ?
j'ai cherché, mais en vain

Merci beaucoup

**Oliv-** · 31/01/2018, 12h38

regarde dans les post précédents, si tu as bien suivi mes instructions tu as du ajouter une ligne

qui commence par debug.print len(...)

Len() te permet d'obtenir la longueur de la chaine de caractères je pense que c'est limité à 256

left(tachaine,256) pour tronquer

**r.sandrine** · 31/01/2018, 12h45

J'avais déjà mis le left (lachaine,256)
j'en ai rajouté un en plus limité à 30 caractères sur le nom de l'expéditeur
et j'ai rajouté les lignes de debug , attendons de voir les prochains emails de cet expéditeur ...

Merci

Enregistrer des pièces jointes automatiquement

Outlook

Discussions similaires

Partager

Partager