Discussion :

[WillyBsm]

Bonjour à tous

J'utilise la macro suivante pour récupérer les Pièces jointes stockées dans le sous dossier de la boite de réception nommé GARDE.

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
 
Sub SaveAttachments(strPath As String)
 
Dim Ol_App As New Outlook.Application
Dim Ol_MAPI As Outlook.NameSpace
Dim Ol_Items As Outlook.Items
Dim Ol_Item As Outlook.MailItem
 
Dim strAttachment As String
Dim NbAttachments As Integer
Dim i As Integer
Dim NbEmails As Integer
 
Set Ol_MAPI = Ol_App.GetNamespace("MAPI")
Set Ol_Items = Ol_MAPI.PickFolder.Items
 
For Each Ol_Item In Ol_Items
 
NbAttachments = Ol_Item.Attachments.Count
i = 1
 
Do While i <= NbAttachments
strAttachment = Ol_Item.Attachments.Item(i).FileName
Ol_Item.Attachments.Item(i).SaveAsFile strPath & strAttachment
i = i + 1
Loop
 
Next Ol_Item
 
Set Ol_Item = Nothing
Set Ol_Items = Nothing
Set Ol_MAPI = Nothing
Set Ol_App = Nothing
 
End Sub
 
Sub RecupPJGarde()
Call SaveAttachments("C:\MODULE_POMPIERS\Gardes\GARDE_VALIDE\2009\JANVIER\")
End Sub

Mon problème est dans le chemin

Code :

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

Call SaveAttachments("C:\MODULE_POMPIERS\Gardes\GARDE_VALIDE\2009\JANVIER")

ou ici 2009 et JANVIER sont " fixes " et je souhaiterai quils soient remplacés par l'année et le mois en cours de réception du mail.

De plus , le top serait de récupérer en parallèle dans un autre dossier
C:\MODULE_POMPIERS\Gardes\MAIL_GARDE\2009\JANVIER\
stocké en .txt le message du mail avec pour nom de sauvegarde l'adresse de l'expéditeur

et enfin pour finir, une précision, cette macro est stockée dans un module et appelée par un bouton, si je la place dans " ThisOutlookSession " elle sera lancée à l'ouverture de outlook c'est bien ça ?

Si oui j'ai en fait une autre macro identique mais traitant le sous dossier EQUIPE, cette macro peut être à la suite de la première dans " ThisOutlookSession " ?
Merci beaucoup pour votre aide
William

[WillyBsm]

Re bonjour
j'ai un peu progressé concernant l'année et mois en cours :

Code :

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

1
2
3
4
5
6
7
8
9
Sub RecupPJGarde()
Dim DateAm As Date
DateAm = Now()
 
annee = Format(DateAm, "yyyy")
Mois = Format(DateAm, "mmmm")
 
Call SaveAttachments("C:\MODULE_AGENT\Gardes\GARDE_VALIDE\annee\Mois\")
End Sub

Si je fait MsgBox annee ou MsgBox Mois, j'ai le résultat correct par contre
pour le chemin je retourne toujours une erreur et la ou les pièces jointes ne sont pas envoyées ????

merci
William

[Oliv-]

SAlut,

Il y a une erreur dans ta syntaxe

Code :

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

Call SaveAttachments("C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee & "\"  & Mois &"\")

sinon il analyse cela comme un dossier se nommant "annee" avec un sous dossier se nommant "mois"

De plus il me semble qu'il faille que les dossiers existes tu peux utiliser :

Code :

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

1
2
3
4
5
6
7
If "" = Dir("C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee", vbDirectory) Then
MkDir "C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee"
End
If "" = Dir("C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee & "\"  & Mois, vbDirectory) Then
MkDir "C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee & "\"  & Mois
End If
End If

Pour sauvegarder ton corps de message c'est :

Code :

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

Ol_Item.SaveAs "monmail.txt", OlSaveAsType.olTXT

Pour lancer à l'ouverture la macro met dans ThisOutlookSession

Code :

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

1
2
3
Private Sub Application_Startup()
RecupPJGarde
end sub

Par contre tu dois choisir le dossier, pour rendre cela automatique, tu peux modifier ta macro principale
modifies

Code :

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

Set Ol_Items = Ol_MAPI.PickFolder.Items

par

Code :

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

Set Ol_Items = Ol_MAPI.GetDefaultFolder(olFolderInbox).Folders("test").Items

si tu veux utiliser cette macro sur plusieurs dossiers ajoute un paramétre pour le dossier outlook :

Code :

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

1
2
3
4
Sub SaveAttachments(strPath As String, strDossier as string)
...
Set Ol_Items = Ol_MAPI.GetDefaultFolder(olFolderInbox).Folders(strDossier).Items
...

[WillyBsm]

Bonjour Oliv et merci beaucoup de ton aide

Concernant l'erreur de syntaxe, ça fonctionne parfaitement maintenant

Concernant :

Code :

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

1
2
3
4
5
6
7
If "" = Dir("C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee", vbDirectory) Then
MkDir "C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee"
End
If "" = Dir("C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee & "\"  & Mois, vbDirectory) Then
MkDir "C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee & "\"  & Mois
End If
End If

Lors de l'envoi du mail le dossier année et mois si ils n'existent pas sont créés par l'appication qui envoi le mail.
Mais par prudence ça serait effectivement bien que je teste si les dossiers existent.

Par contre je ne sais pas trop ou placer mon " Call SaveAttachments " dans ta macro, est ce cela ? :

Code :

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

1
2
3
4
5
6
7
8
If "" = Dir("C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee", vbDirectory) Then
MkDir "C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee"
End
If "" = Dir("C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee & "\"  & Mois, vbDirectory) Then
MkDir "C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee & "\"  & Mois
Call SaveAttachments (MkDir)
End If
End If

Concernant :

Code :

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

Set Ol_Items = Ol_MAPI.GetDefaultFolder(olFolderInbox).Folders("DISPO GARDE").Items

C'est super, j'aurai jamais trouvé sans ton aide

concernant l'ouverture de la macro dans ThisOutlookSession j'ai ajouté mes macros comme ceci :

Code :

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

1
2
3
4
Private Sub Application_Startup()
RecupPJGarde
RecupPJEquipe
end sub

Concernant :

Code :

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

1
2
3
Sub SaveAttachments(strPath As String, strDossier as string)
...
Set Ol_Items = Ol_MAPI.GetDefaultFolder(olFolderInbox).Folders(strDossier).Items

La par contre si j'ai bien compris c'est pour utiliser ma macro RecupPJGarde avec plusieurs dossiers ? Je dois placer ces lignes dans ThisOutlookSession ?

En tout cas bravo, merci encore de ton aide
William

[WillyBsm]

Re bonjour, Re bonjour Oliv

j'ai essayé

Code :

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

Ol_Item.SaveAs "monmail.txt", OlSaveAsType.olTXT

ça marche impeccable par contre le fichier txt est sauvegardé dans :
C:\Program Files\Fichiers communs\System\Mapi\1036\NT

Je souhaiterai le sauver dans :
C:\MODULE_AGENT\E-MAIL\GARDE_VALIDE\"
de plus, il y aura autant de fichiers txt à sauver que de pièces jointes, l'idéal
serait de remplacer "monmail.txt" par l'adresse de l'expediteur
j'ai pas trouvé comment faire cela.

merci William

[Oliv-]

Code :

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

1
2
3
4
5
6
7
If "" = Dir (strPath , vbDirectory) Then
MkDir strPath 
End
If "" = Dir("C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee & "\"  & Mois, vbDirectory) Then
MkDir "C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee & "\"  & Mois
End If
End If

doit être mis au début de SaveAttachments enutilisant les parametres de la macro strPath ...

concernant l'ouverture de la macro dans ThisOutlookSession j'ai ajouté mes macros comme ceci :

J'aurais fait comme cela, si c'est la même action pour le 2 macros

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Application_Startup()
Dim DateAm As Date
DateAm = Now()
 
annee = Format(DateAm, "yyyy")
Mois = Format(DateAm, "mmmm")
 
Call SaveAttachments("C:\MODULE_AGENT\Gardes\GARDE_VALIDE\" & annee & "\"  & Mois &"\"),"GARDE")
 
Call SaveAttachments("C:\MODULE_AGENT\EQUIPE\" & annee & "\"  & Mois &"\"),"EQUIPE")
 
end sub

Concernant :

Code :

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

1
2
3
Sub SaveAttachments(strPath As String, strDossier as string)
...
Set Ol_Items = Ol_MAPI.GetDefaultFolder(olFolderInbox).Folders(strDossier).Items

William

[WillyBsm]

Je te remercie beaucoup Oliv pour tes lumières et ta patiente envers le débutant que je suis.


merci, William

[Oliv-]

J'espère que tu as réussi à remettre tout cela dans l'ordre car je n'ai pas vérifié s'il fonctionnait correctement,je n'avais pas vraiment le temps.